Excel Tabelle mittels VBA Werte vergleichen und bei Übereinstimmung Namen zu weisen
Hallo
ich habe eine Excel Tabelle da ist Spalte A mit Kennziffern belegt, die Kennziffern können mehrfach vorkommen. Spalte B bestimmte Teile namen. Spalte C enthält die Anzahl der Teilenamen. Spalte D,E,F ist leer ab Spalte G stehen wieder die Kennziffern und in H der Hersteller.
sieht so aus
A B C D E F G H
4 einl 100 0 Maier
4 zweil 23 1 Müller
12 drei 1230 2 Schmidt
123 xxxx 200 3 Krause
9088 yyyy 68 4 Hermann
9088 zzzz 999 5 Klaus
9999 dddd 10 6 Bernd
ich möchte das in Zeile A die Kennziffer gegen den Hersteller namen ausgetauscht wird aber leider hab ich keinen richtigen Plan.
Hat jemand eine Idee wie man das mittels VBA lösen kann.
Danke
VG
Tommhi
ich habe eine Excel Tabelle da ist Spalte A mit Kennziffern belegt, die Kennziffern können mehrfach vorkommen. Spalte B bestimmte Teile namen. Spalte C enthält die Anzahl der Teilenamen. Spalte D,E,F ist leer ab Spalte G stehen wieder die Kennziffern und in H der Hersteller.
sieht so aus
A B C D E F G H
4 einl 100 0 Maier
4 zweil 23 1 Müller
12 drei 1230 2 Schmidt
123 xxxx 200 3 Krause
9088 yyyy 68 4 Hermann
9088 zzzz 999 5 Klaus
9999 dddd 10 6 Bernd
ich möchte das in Zeile A die Kennziffer gegen den Hersteller namen ausgetauscht wird aber leider hab ich keinen richtigen Plan.
Hat jemand eine Idee wie man das mittels VBA lösen kann.
Danke
VG
Tommhi
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 227948
Url: https://administrator.de/contentid/227948
Ausgedruckt am: 22.11.2024 um 18:11 Uhr
19 Kommentare
Neuester Kommentar
Hallo Tommih,
mach dir eine Hilfsspalte z.B. nehme die Spalte E, dort fügst du dann in die erste Zelle folgende Formel ein:
und kopierst sie über das kleine Viereck unten rechts in der Zelle nach unten.
Falls du es doch mit VBA machen willst hier der Code dafür, wenn ich deine Tabelle richtig interpretiert habe:
Hier das Demo-Sheet dazu.
Grüße Uwe
mach dir eine Hilfsspalte z.B. nehme die Spalte E, dort fügst du dann in die erste Zelle folgende Formel ein:
=SVERWEIS($A1;$G:$H;2;FALSCH)
Falls du es doch mit VBA machen willst hier der Code dafür, wenn ich deine Tabelle richtig interpretiert habe:
Sub Zuordnen()
Set sheet = Worksheets(1)
Set rngSearchStart = sheet.Range("G1")
Set rngSearchEnd = rngSearchStart.End(xlDown)
Set rngTargetStart = sheet.Range("A1")
Set rngTargetEnd = rngTargetStart.End(xlDown)
For Each cell In sheet.Range(rngTargetStart, rngTargetEnd)
Set foundCell = sheet.Range(rngSearchStart, rngSearchEnd).Find(cell.Value, LookIn:=xlValues)
If Not foundCell Is Nothing Then
cell.Value = foundCell.Offset(0, 1).Value
End If
Next
End Sub
Hier das Demo-Sheet dazu.
Grüße Uwe
was für eine Fehlermeldung bringt er denn? denn hier geht es einwandfrei
hast du wohlmöglich die erste Zeile weggelassen? :
oder du musst den Verweis an dein Ziel-Workbook entsprechend anpassen, vorher am besten einen Verweis darauf erstellen, da du ansonsten das Import-Workbook referenzierst.
sieh dir auch mal das Demo-Sheet von oben an...
Grüße Uwe
hast du wohlmöglich die erste Zeile weggelassen? :
Set sheet = Worksheets(1)
oder du musst den Verweis an dein Ziel-Workbook entsprechend anpassen, vorher am besten einen Verweis darauf erstellen, da du ansonsten das Import-Workbook referenzierst.
Set sheet = Workbooks(1).Worksheets(1)
sieh dir auch mal das Demo-Sheet von oben an...
Grüße Uwe
OK dann hast du oben in deinem Projekt Option Explicit stehen, das bedeutet du musst die Variablen über Dim alle vorher definieren, wie hier
Sub Zuordnen()
dim sheet as Worksheet, rngSearchStart as Range, rngSearchEnd as Range, rngTargetStart as Range, rngTargetEnd as Range, cell as Range, foundCell as Variant
Set sheet = Worksheets(1)
Set rngSearchStart = sheet.Range("G1")
Set rngSearchEnd = rngSearchStart.End(xlDown)
Set rngTargetStart = sheet.Range("A1")
Set rngTargetEnd = rngTargetStart.End(xlDown)
For Each cell In sheet.Range(rngTargetStart, rngTargetEnd)
Set foundCell = sheet.Range(rngSearchStart, rngSearchEnd).Find(cell.Value, LookIn:=xlValues)
If Not foundCell Is Nothing Then
cell.Value = foundCell.Offset(0, 1).Value
End If
Next
End Sub
Zitat von @tommhii:
ja ich wollte mir ja nicht die 1. Zeile überschreiben. Was micht noch stört das die Schaltfläche noch zu sehen ist
kann man die irgendwie im Nachgang ausblenden.
kann man via Code machen, aber dazu müsstest du den Typ des Buttons erst noch in ein ActiveX-Button ändern. Du kannst ihn aber auch manuell rauslöschen: einmal Rechtsklick auf den Button damit dieser markiert ist, und dann ENTF drücken.ja ich wollte mir ja nicht die 1. Zeile überschreiben. Was micht noch stört das die Schaltfläche noch zu sehen ist
kann man die irgendwie im Nachgang ausblenden.
wie schon gesagt eine Pivot-Tabele erledigt das mit 3 Klicks, die Leute wissen nur meistens nicht, wie diese anzuwenden sind ...
Demo-Pivot-Tabelle
Demo-Pivot-Tabelle
klar geht das alles mit entsprechendem Aufwand, mach doch einfach einen Import der Daten in diese Vorlage mit der Pivot-Tabelle dann ist dies ebenfalls automatisiert, und die Pivot-Tabelle wieder aktuell.
Die Pivottabelle lässt sich natürlich auch automatisiert via VBA erstellen :
Demo_Pivot_Automated_227948.xlsm
Die Pivottabelle lässt sich natürlich auch automatisiert via VBA erstellen :
Demo_Pivot_Automated_227948.xlsm
Zitat von @tommhii:
danke dafür , aber was muss ich ändern wenn die Pivot-Tabelle in einen anderen Tabellenblatt entstehen soll.
diesen Code nehmen und in Zeile 4 das Destination-Sheet angeben, Zeile 5 legt die Zelle im Destination-Sheet fest.danke dafür , aber was muss ich ändern wenn die Pivot-Tabelle in einen anderen Tabellenblatt entstehen soll.
Sub CreatePivotTable()
Dim rngData As Range, rngStart As Range, rngEnd As Range, sheet As Worksheet
Set sheet = Worksheets(1)
Set targetsheet = Worksheets(2)
Set rngDestination = targetsheet.Range("A1")
Set rngStart = sheet.Range("B3")
Set rngEnd = rngStart.End(xlDown).Offset(0, 2)
Set rngData = sheet.Range(rngStart, rngEnd)
On Error Resume Next
If Not targetsheet.PivotTables("Auswertung") Is Nothing Then
targetsheet.PivotTables("Auswertung").TableRange2.Clear
End If
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData).CreatePivotTable TableDestination:=rngDestination, TableName:="Auswertung"
With targetsheet.PivotTables("Auswertung").PivotFields("Herstellername")
.Orientation = xlRowField
.Position = 1
End With
With targetsheet.PivotTables("Auswertung").PivotFields("TeileName")
.Orientation = xlColumnField
.Position = 1
End With
targetsheet.PivotTables("Auswertung").AddDataField targetsheet.PivotTables("Auswertung").PivotFields("Anzahl"), "Summe von Anzahl", xlSum
End Sub