1.2k Aufrufe
Gefragt in Tabellenkalkulation von letty19 Einsteiger_in (88 Punkte)
Bearbeitet von halfstone
Hi Leute

Hab dieses Makro hier im Forum gefunden und würde einen kleine Änderung benötigen

Sub Summe_Zeile_12_13()

Dim strEingabe As String
Dim arrEingabe As Variant
Dim lngLSpalte As Long
Dim lngZaehler As Long
Dim i As Long

'Suchzahlen abfragen
strEingabe = InputBox("Bitte geben Sie Zahlen durch Komma getrennt ein!", "Summe Zeile 12+13")

'Falls keine Eingabe erfolgt, Makro beenden
If Len(strEingabe) = 0 Then
MsgBox "Es ist keine Eingabe erfolgt!", 16, "Abbruch"
Exit Sub
End If

'Eingabe aufteilen
arrEingabe = Split(strEingabe, ",")

With ActiveSheet
  'letzte Spalte in Zeile 4 ermitteln
   lngLSpalte = .Cells(11, Columns.Count).End(xlToLeft).Column

   For lngSpalte = 1 To lngLSpalte
      For i = LBound(arrEingabe) To UBound(arrEingabe)
        If .Cells(12, lngSpalte).Value + .Cells(13, lngSpalte).Value = CLng(arrEingabe(i)) Then
           lngZaehler = lngZaehler + 1
           .Range(.Cells(12, lngSpalte), .Cells(13, lngSpalte)).Interior.ColorIndex = 7 '7 purpur
        End If
      Next i
    Next lngSpalte
End With

If lngZaehler = 0 Then MsgBox "Es wurden keine Übereinstimmungen gefunden!", 48, "Hinweis"

End Sub

Könnte man das Makro so umschreiben ohne die Inputbox aufzurufen.

D.h  Wert aus Tabelle1 Zeile 5 (zb.Zahl 65) = Summe Zeile 12+13 von Tabelle 2.

Super wäre es nicht nur die Zahl 65 sondern auch Zahl 64,63 in Zeile 12+13 von Tabelle 2 farbig zu markieren.

So wie in der Inputbox da kann man auch mit Beistrich zwischen andere Zahlen mit eingeben

9 Antworten

0 Punkte
Beantwortet von m-o Profi (22.9k Punkte)

Hallo Lefty19,

du schreibst

D.h  Wert aus Tabelle1 Zeile 5 (zb.Zahl 65) = Summe Zeile 12+13 von Tabelle 2

Stehen in Tabelle 1 in Zeile 5 mehrere Zahlen oder nur eine?

Gruß

M.O.

0 Punkte
Beantwortet von letty19 Einsteiger_in (88 Punkte)
Hi

M.O

In Tabelle1 Zeile 5 steht nur eine Zahl.
0 Punkte
Beantwortet von m-o Profi (22.9k Punkte)

Hallo Lefty,

also Zeile 5 (Zelle A5???) steht die Zahl, die du suchst (und die sich ändern kann???).

Du schreibst

Super wäre es nicht nur die Zahl 65 sondern auch Zahl 64,63 in Zeile 12+13 von Tabelle 2 farbig zu markieren.

Willst du auch noch die beiden nächstkleineren Zahlen suchen? Oder wie ist das gemeint.

In deiner Beschreibung ist die Zahl in Zeile 5 ja 65. Wenn jetzt in Zelle A5 die Zahl 79 steht, sollen dann auch 78 und 77 als Summe gesucht werden?

Gruß

M.O.

0 Punkte
Beantwortet von letty19 Einsteiger_in (88 Punkte)
Ja genau

In der Inputbox konnte man mehrere Zahlen durch Beistrich getrennt als Summe suchen.

Bis Minus 2 Zahlen wäre super so wie du es beschrieben hast
0 Punkte
Beantwortet von m-o Profi (22.9k Punkte)
ausgewählt von halfstone
 
Beste Antwort
Hallo Lefty19,

probiere mal den folgenden Code:

Sub Summe_Zeile_12_13()

Dim arrEingabe(2) As Long
Dim lngLSpalte As Long
Dim lngZaehler As Long
Dim lngSpalte As Long
Dim i As Long

'Wert aus Zelle A5 in Tabelle1 auslesen
arrEingabe(0) = ThisWorkbook.Worksheets("Tabelle1").Range("A5").Value
arrEingabe(1) = arrEingabe(0) - 1
arrEingabe(2) = arrEingabe(0) - 2

With ThisWorkbook.Worksheets("Tabelle2")
  'letzte Spalte in Zeile 12 von Tabelle2 ermitteln
   lngLSpalte = .Cells(12, Columns.Count).End(xlToLeft).Column
   'Spalten durchlaufen
   For lngSpalte = 1 To lngLSpalte
      For i = LBound(arrEingabe) To UBound(arrEingabe)
        'falls Summe der Spalten in Zeilen 12 und 13 gleich der Suchzahlen
        If .Cells(12, lngSpalte).Value + .Cells(13, lngSpalte).Value = CLng(arrEingabe(i)) Then
           'dann Zellen färben (Farbe Zahl zwischen 1 und 56
           .Range(.Cells(12, lngSpalte), .Cells(13, lngSpalte)).Interior.ColorIndex = 7 '7 purpur
           lngZaehler = lngZaehler + 1   'Zähler nur für Meldung, falls keine Übereinstimmung gefunden
        End If
      Next i
    Next lngSpalte
End With

If lngZaehler = 0 Then MsgBox "Es wurden keine Übereinstimmungen gefunden!", 48, "Hinweis"

End Sub

Der Startwert wird aus Zelle A5 in Tabelle1 gelesen. Die Zeilen 12 und 13 in Tabelle2 werden durchsucht und falls die Summe der Werte einer Spalte den Suchwerten entsprechen, dann erfolgt die farbliche Markierung.

Gruß

M.O.
0 Punkte
Beantwortet von letty19 Einsteiger_in (88 Punkte)
Super

funktioniert bestens

Klasse M.O

Danke
0 Punkte
Beantwortet von letty19 Einsteiger_in (88 Punkte)
Hi

M.O

Jetzt hab ich doch noch eine Frage wenn die Zahl 0 oder 1 als Summe gesucht wird

wird dann trotzdem in der Tabelle2 die Zeile 12+13 eingefärbt obwohl die Zellen leer sind..

Kann man das irgendwie einstellen das dann nicht eingefärbt wird ?
0 Punkte
Beantwortet von m-o Profi (22.9k Punkte)

Hallo,

mit dem folgenden Code werden nur Spalten markiert, in denen sowohl in Zeile 12 als auch in Zeile 13 Zahlen stehen:

Sub Summe_Zeile_12_13()

Dim arrEingabe(2) As Long
Dim lngLSpalte As Long
Dim lngZaehler As Long
Dim lngSpalte As Long
Dim i As Long

'Wert aus Zelle A5 in Tabelle1 auslesen
arrEingabe(0) = ThisWorkbook.Worksheets("Tabelle1").Range("A5").Value
arrEingabe(1) = arrEingabe(0) - 1
arrEingabe(2) = arrEingabe(0) - 2

With ThisWorkbook.Worksheets("Tabelle2")
  'letzte Spalte in Zeile 12 von Tabelle2 ermitteln
   lngLSpalte = .Cells(12, Columns.Count).End(xlToLeft).Column
   'Spalten durchlaufen
   For lngSpalte = 1 To lngLSpalte
      For i = LBound(arrEingabe) To UBound(arrEingabe)
        'falls Summe der Spalten in Zeilen 12 und 13 gleich der Suchzahlen
        If .Cells(12, lngSpalte).Value + .Cells(13, lngSpalte).Value = CLng(arrEingabe(i)) Then
           'nun noch prüfen, ob in den Spalten überhaupt etwas drin steht
           If IsEmpty(.Cells(12, lngSpalte)) = False And IsEmpty(.Cells(13, lngSpalte)) = False Then
             'dann Zellen färben (Farbe Zahl zwischen 1 und 56
             .Range(.Cells(12, lngSpalte), .Cells(13, lngSpalte)).Interior.ColorIndex = 7 '7 purpur
             lngZaehler = lngZaehler + 1   'Zähler nur für Meldung, falls keine Übereinstimmung gefunden
           End If
        End If
      Next i
    Next lngSpalte
End With

If lngZaehler = 0 Then MsgBox "Es wurden keine Übereinstimmungen gefunden!", 48, "Hinweis"

End Sub


Gruß

M.O.

0 Punkte
Beantwortet von letty19 Einsteiger_in (88 Punkte)
Super

Danke
...