Programmieren - alles kontrollieren 4.941 Themen, 20.708 Beiträge

Verfolgung starten Optionen

[Excel 2007] Tabellenspalten vergleichen

cosmo_kramer / 15 Antworten / Baumansicht Nickles

Hallo Leute,

ich habe zwei Fragen :

Dieser Makro-VBA-Code prüft eine Spalte von 2 verschiedenen Tabellenblättern und markiert Übereinstimmungen im aktiven Blatt grün.

For ZeileB1 = 3 To 150
For ZeileB2 = 3 To 150
If ThisWorkbook.ActiveSheet.Range("B" & ZeileB1) = Sheets("8.KW").Range("B" & ZeileB2) Then
ThisWorkbook.ActiveSheet.Range("B" & ZeileB1 & ":" & "B" & ZeileB1).Select
With Selection.Interior
.Color = 5287936
End With
End If
Next ZeileB2
Next ZeileB1

1. Frage :
Wie bringe ich das Makro dazu, statt zu Färben gleich die komplette Zeile zu übernehmen?

2. Frage :
Wie bringe ich das Makro dazu, Spalte B des aktiven Blattes mit Spalte B des vorherigen Blattes miteinander zu vergleichen ?
Erklärung dazu : In der Mappe kommt jede Woche ein neues Blatt hinzu, welches nur mit der Vorwoche verglichen werden muss. Im oberen Code wird der Vergleich zwischen ActiveSheet und 8.KW angestoßen, ich benötige aber eher Vergleich zw. ActiveSheet und ActiveSheet-1.

Vielen Dank.

bei Antwort benachrichtigen
PaoloP cosmo_kramer „[Excel 2007] Tabellenspalten vergleichen“
Optionen

1.
komplette Zeile im Sinne der ganzen Row?

2.
Über ActiveWorkbook.Worksheets findest du alle Sheets,
deine Aufgabe ist es die darin beiden zu finden die du vergleichen möchtest.
Das beste Kriterium ist wahrscheinlich der Name.


Jedes mal wenn jemand "Cloud" sagt, verliert ein Engel seine Flügel.
bei Antwort benachrichtigen
cosmo_kramer PaoloP „1. komplette Zeile im Sinne der ganzen Row? 2. Über ActiveWorkbook.Worksheets...“
Optionen

@PaoloP :
zu 1.
Es wird Spalte B des letzten (9.KW) mit dem vorletzten (8.KW) Tabellenblatt verglichen.
Aktuell wird bei Übereinstimmung der entsprechende Wert im letzten Tabellenblatt farbig gekennzeichnet.
Noch schöner wäre es, wenn bei Übereinstimmung die komplette Zeile aus der "Vorwoche" auf die entsprechende Zeile der "aktuellen Woche" kopiert wird.
Die Werte können aber jede Woche in einer anderen Zeile innerhalb von Spalte b stehen.

zu 2.
Den Teil habe ich lösen können mit
Worksheets(Sheets.Count) und Worksheets(Sheets.Count - 1) .
Nun werden in meinem Makro immer Spalte B des letzten und des vorletzten Blattes verglichen.

Vielen Dank.

bei Antwort benachrichtigen
PaoloP cosmo_kramer „@PaoloP : zu 1. Es wird Spalte B des letzten 9.KW mit dem vorletzten 8.KW...“
Optionen

Sicher nicht die eleganteste Lösung aber mehr ist aus dem Stand nicht drin.
Benutzt sich hoffentlich Selbsterklärend. Ungetestet.


Private Sub CopyRowValues(SourceSheet As Excel.Worksheet, lRowSourceIndex As Long, _
DestinationSheet As Excel.Worksheet, lRowDestIndex As Long)


Dim rSource As Excel.Range
Set rSource = SourceSheet.Rows(lRowSourceIndex)
Dim rDest As Excel.Range
Set rDest = SourceSheet.Rows(lRowDestIndex)

Dim rCell As Excel.Range

For Each rCell In rSource.Cells

rDest.Cells(, rCell.Column).Value = rCell.Value

Next rCell


End Sub

Jedes mal wenn jemand "Cloud" sagt, verliert ein Engel seine Flügel.
bei Antwort benachrichtigen
cosmo_kramer PaoloP „Sicher nicht die eleganteste Lösung aber mehr ist aus dem Stand nicht drin....“
Optionen

@PaoloP :
Vielen Dank für Deine Antwort - leider bin ich ihrer nicht würdig, weil : ich komm nicht klar...


For ZeileB1 = 3 To 150
For ZeileB2 = 3 To 150
If Worksheets(Sheets.Count).Range("B" & ZeileB1) = Worksheets(Sheets.Count - 1).Range("B" & ZeileB2) Then
Worksheets(Sheets.Count).Range(ZeileB1 & ":" & ZeileB1).Select
With Selection.Interior
.Color = 5287936
End With
End If
Next ZeileB2
Next ZeileB1

Die ist mein aktueller Code, welcher Spalte B von Blatt X innerhalb der Zeilen von 3 bis 150 mit Spalte B von Blatt X-1 vergleicht und bei gefundenen gleichen Werten die Zeilen in Blatt X farbig markiert.

In der genannten Excel-Mappe werden Woche für Woche Aufträge geprüft (für jede KW ein Blatt) und manuell um weitere Informationen ergänzt. Einige Aufträge aus der Vorwoche sind noch nicht erledigt -stehen also im aktuellen Blattmit drin-, andere sind erledigt und wiederum andere sind hinzugekommen.
Damit aber wirklich nur die neu hinzugekommenen Aufträge geprüft werden, benötige ich diese Funktion des Vergleichens und Kopieren/Einfügen.

Danke und Grüße.

bei Antwort benachrichtigen
Borlander cosmo_kramer „@PaoloP : Vielen Dank für Deine Antwort - leider bin ich ihrer nicht würdig,...“
Optionen

Wo genau hakt es denn nun jetzt noch? Das sieht doch optisch erstmal gar nicht so schnelcht aus. Hab allerdings gerade kein Excel zur Verfügung zum testen...

Wenns eine Fehlermeldung beim ausführen gibt solltest Du uns die genaue Position angeben an der sie gemeldet wird.


Gruß
Borlander

bei Antwort benachrichtigen
Borlander PaoloP „1. komplette Zeile im Sinne der ganzen Row? 2. Über ActiveWorkbook.Worksheets...“
Optionen
ActiveWorkbook.Worksheets
Lieber ThisWorkbook verwenden - das bezieht sich immer auf die Arbeitsmappe in der das Makro gespeichert ist. Wird auch in der Excel-VBA-Referenz so empfohlen ;-)
bei Antwort benachrichtigen
PaoloP Borlander „ Lieber ThisWorkbook verwenden - das bezieht sich immer auf die Arbeitsmappe in...“
Optionen

Da war was hinsichtlich der ThisObjects in Excel ich erinner mich.
Es ist so das Excel für den programmatischen Zugriff und für den User
während der Ausführung eines Makros gesperrt ist. Das gilt wie gesagt nur
für die Makro Ausführung d.h. =FunctionBlub() in einer Zelle. die ThisObjects soll man
im Makro dann nur zur späteren Verwendung wegspeichern.
Ruft man die gleiche Funktion über einen platzierten Button auf ist das unkritischer.
Ruft man also eine eigene VBA Funktion als Formel in einer Zelle auf wird sie zum Makro und kann je nach Code dann auf einmal scheitern. Ganz schön crazy :-)

Jedes mal wenn jemand "Cloud" sagt, verliert ein Engel seine Flügel.
bei Antwort benachrichtigen
cosmo_kramer PaoloP „Da war was hinsichtlich der ThisObjects in Excel ich erinner mich. Es ist so das...“
Optionen

@ Borlander :
zu ActiveWorkbook.Worksheets :
Danke - geändert .

zu "Wo hakt es ?" :

Der Code "färbt" nur - das funktioniert gut !
For ZeileB1 = 3 To 150
For ZeileB2 = 3 To 150
If ActiveWorkbook.Worksheets(Sheets.Count).Range("B" & ZeileB1) = ActiveWorkbook.Worksheets(Sheets.Count - 1).Range("B" & ZeileB2) Then
ActiveWorkbook.Worksheets(Sheets.Count).Range(ZeileB1 & ":" & ZeileB1).Select
With Selection.Interior
.Color = 5287936
End With
End If
Next ZeileB2
Next ZeileB1

Er soll aber bei Übereinstimmung die komplette Zeile aus der "Vorwoche"(.Count - 1) auf die entsprechende Zeile der "aktuellen Woche"(.Count) kopieren, "damit aber wirklich nur die neu hinzugekommenen Aufträge geprüft werden".

Danke und Grüße.

bei Antwort benachrichtigen
PaoloP cosmo_kramer „@ Borlander : zu ActiveWorkbook.Worksheets : Danke - geändert . zu Wo hakt es ?...“
Optionen

Ich versteh dich nicht, du musst doch nur noch das da rausschmeissen:

ActiveWorkbook.Worksheets(Sheets.Count).Range(ZeileB1 & ":" & ZeileB1).Select
With Selection.Interior
.Color = 5287936
End With


und stattdessen die Funktion die oben von mir geschrieben steht aufrufen also:

CopyRowValues(ActiveWorkbook.Worksheets(Sheets.Count - 1), ZeileB2 , _
ActiveWorkbook.Worksheets(Sheets.Count), ZeileB1 )



Whats the Problem?
*schulterzuck*

Jedes mal wenn jemand "Cloud" sagt, verliert ein Engel seine Flügel.
bei Antwort benachrichtigen
cosmo_kramer PaoloP „Ich versteh dich nicht, du musst doch nur noch das da rausschmeissen:...“
Optionen

@PaoloP :
Ich versteh das auch nicht ...

wenn ich aus
For ZeileB1 = 3 To 150
For ZeileB2 = 3 To 150
If ActiveWorkbook.Worksheets(Sheets.Count).Range("B" & ZeileB1) = ActiveWorkbook.Worksheets(Sheets.Count - 1).Range("B" & ZeileB2) Then
ActiveWorkbook.Worksheets(Sheets.Count).Range(ZeileB1 & ":" & ZeileB1).Select
With Selection.Interior
.Color = 5287936
End With
End If
Next ZeileB2
Next ZeileB1

das mache :

For ZeileB1 = 3 To 50
For ZeileB2 = 3 To 50
If ActiveWorkbook.Worksheets(Sheets.Count).Range("B" & ZeileB1) = ActiveWorkbook.Worksheets(Sheets.Count - 1).Range("B" & ZeileB2) Then
CopyRowValues(ActiveWorkbook.Worksheets(Sheets.Count - 1), ZeileB2 , _
ActiveWorkbook.Worksheets(Sheets.Count), ZeileB1 )
End If
Next ZeileB2
Next ZeileB1

bekomme ich einen Syntax-Fehler gemeldet in der Zeile.

Im Klartext :
Ich weiß nicht, was ich da machen kann. Ich bekomme Deinen Code nicht zum laufen in meiner Mappe.

Thats the Problem!
*schulterzuck*

Danke und Grüße.

bei Antwort benachrichtigen
cosmo_kramer Nachtrag zu: „@PaoloP : Ich versteh das auch nicht ... wenn ich aus For ZeileB1 3 To 150 For...“
Optionen

Set wks1 = ThisWorkbook.Worksheets(Sheets.Count)
Set wks2 = ThisWorkbook.Worksheets(Sheets.Count - 1)

For ZeileB1 = 3 To 100
For ZeileB2 = 3 To 100
If wks1.Range("B" & ZeileB1) = wks2.Range("B" & ZeileB2) Then
CopyRowValues(wks2, ZeileB2, wks1, ZeileB1)
End If
Next ZeileB2
Next ZeileB1

Hab den Code etwas aufgehübscht.
Deine Zeile CopyRowValues(ActiveWorkbook.Worksheets(Sheets.Count - 1), ZeileB2 , _
ActiveWorkbook.Worksheets(Sheets.Count), ZeileB1 ) sieht dann ja so aus :
CopyRowValues(wks2, ZeileB2, wks1, ZeileB1)
Wenn diese wie im Code oben eingefügt wird, meldet VB :
"Fehler beim Kompilieren - Erwartet : = " .
Beim Durchlauf kommt eben auch der Syntaxfehler für diese Zeile.

Da ich ein Laie bin, komme ich hier nicht weiter.

Vielen Dank für die bisherige Hilfe und fürs Verständnis.

Grüße.
bei Antwort benachrichtigen
cosmo_kramer Nachtrag zu: „ Set wks1 ThisWorkbook.Worksheets Sheets.Count Set wks2 ThisWorkbook.Worksheets...“
Optionen

Dieser Code erfüllt meine Wünsche :

Sub Vergleich()

Set wks1 = ThisWorkbook.Worksheets(Sheets.Count)
Set wks2 = ThisWorkbook.Worksheets(Sheets.Count - 1)

For ZeileB1 = 3 To 100
For ZeileB2 = 3 To 100
If wks1.Range("B" & ZeileB1) = wks2.Range("B" & ZeileB2) Then
wks2.Range(ZeileB2 & ":" & ZeileB2).Copy Destination:=wks1.Range(ZeileB1 & ":" & ZeileB1)
End If
Next ZeileB2
Next ZeileB1

MsgBox "Vergleich abgeschlossen...", vbInformation
Range("D3").Select

End Sub

Vielen Dank.

grüße

bei Antwort benachrichtigen
PaoloP cosmo_kramer „Dieser Code erfüllt meine Wünsche : Sub Vergleich Set wks1...“
Optionen

Ich hab das hier jetzt mal durch Excel gejagt, und es geht.


Private Sub CommandButton1_Click()
For ZeileB1 = 3 To 50
For ZeileB2 = 3 To 50
If ActiveWorkbook.Worksheets(Sheets.Count).Range("B" & ZeileB1) = ActiveWorkbook.Worksheets(Sheets.Count - 1).Range("B" & ZeileB2) Then
CopyRowValues ActiveWorkbook.Worksheets(Sheets.Count - 1), ZeileB2, ActiveWorkbook.Worksheets(Sheets.Count), ZeileB1
End If
Next ZeileB2
Next ZeileB1
End Sub

Du hast die Sub CopyRowValues mit Klammern um die Parameter also als Funktion aufgerufen
geht auch okay wenn man ein Call davor setzt bzw. besser einfach die Klammern weg nehmen.

Jedes mal wenn jemand "Cloud" sagt, verliert ein Engel seine Flügel.
bei Antwort benachrichtigen
cosmo_kramer PaoloP „Ich hab das hier jetzt mal durch Excel gejagt, und es geht. Private Sub...“
Optionen

@PaoloP:
Du wirst wieder mit der Schulter zucken, aber ich habe Deinen Code
probiert , und ... "Argumenttyp ByRef unverträglich".
Gezeigt wird auf den Wert "ZeileB2" in "CopyRowValues ...(Sheets.Count - 1), ZeileB2 ..." .

*ahnungslosschulterzuck*
Grüße.

bei Antwort benachrichtigen
PaoloP cosmo_kramer „@PaoloP: Du wirst wieder mit der Schulter zucken, aber ich habe Deinen Code...“
Optionen

Das kann sein ja, die Auflistungsobjekte sind erstmal nur Variant und ByRef kann er das natürlich nicht implizit konvertieren. Ändere mal den Funktionskopf zu:

Private Sub CopyRowValues(ByVal SourceSheet As Excel.Worksheet, lRowSourceIndex As Long, _
ByVal DestinationSheet As Excel.Worksheet, lRowDestIndex As Long)

Jedes mal wenn jemand "Cloud" sagt, verliert ein Engel seine Flügel.
bei Antwort benachrichtigen