tommhii
Goto Top

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

Content-ID: 227948

Url: https://administrator.de/contentid/227948

Ausgedruckt am: 22.11.2024 um 18:11 Uhr

colinardo
colinardo 28.01.2014 aktualisiert um 14:05:34 Uhr
Goto Top
Hallo Tommih,
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)
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:
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
tommhii
tommhii 28.01.2014 um 14:45:19 Uhr
Goto Top
Hallo Uwe,

danke für die schnelle Antwort aber dein VBA Code bringt bei mir Fehler beim kompilieren an dieser Stelle
Set rngSearchStart = sheet.Range("G1")

Ich lese die Daten sätze aus 2 verschiedenen TXT Dateien erst die Werte Spalte A-C und dann G und H
Ich habe Deinen Code bei mir eingefügt aber es kommt immer der Fehler. Woran kann das liegen?


Sub einlesen()
ChDir "C:\"
Workbooks.OpenText Filename:="C:\Statistik.txt", Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1)), TrailingMinusNumbers:=True
Range("G1").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Hersteller.txt", _
Destination:=Range("$G$1"))
.Name = "Hersteller"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

VG
Tommhi
colinardo
colinardo 28.01.2014 aktualisiert um 15:02:18 Uhr
Goto Top
was für eine Fehlermeldung bringt er denn? denn hier geht es einwandfrei
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
tommhii
tommhii 28.01.2014 um 15:38:16 Uhr
Goto Top
Hallo Uwe,

dein Demo geht bei mir auch aber so bald ich meinen code vorher ablaufen lasse bringt er Variable nicht definiert
Set rngSearchStart = sheet.Range("G1")


VG
Tommhii
colinardo
Lösung colinardo 28.01.2014 aktualisiert um 15:53:25 Uhr
Goto Top
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
tommhii
tommhii 28.01.2014 um 15:52:01 Uhr
Goto Top
Hallo Uwe
hab nochmal alles kontrolliert geht jetzt habe die Zeile noch zugefügt die war in Deiner Demo drin
Dim sheet As Worksheet, cell As Range

Eine Frage hab ich noch kann ich jetzt noch eine Überschrift mittels vba einfügen, in die erste Zeile mit aktuellen Datum.

Danke nochmal im voraus

VG
Tommhii
colinardo
Lösung colinardo 28.01.2014 aktualisiert um 16:31:42 Uhr
Goto Top
klar, aber wo soll deine erste Zeile sein ? in A1 steht doch schon was
sheet.Range("A1").Value = "Deine Überschrift " & date()
wie hast du eigentlich deinen obigen Code hinbekommen .... ?
tommhii
tommhii 28.01.2014 um 16:41:08 Uhr
Goto Top
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.
colinardo
colinardo 28.01.2014 aktualisiert um 16:50:55 Uhr
Goto Top
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.
tommhii
tommhii 07.02.2014 aktualisiert um 09:52:02 Uhr
Goto Top
Hallo

das hat geklappt, ich habe noch eine ander Frage dazu ich habe 11 verschieden Werkstücke lw , rw; wb (winkel mit Bohrung)
fle, wdb, ufob, ufmb, flemb, dae, daeb, smb diese Teile werden von unterschiedlichen Herstellern produziert.
ich habe jetzt nach dem ich die Daten aus der Datenbank ausgelesen habe folgende Tabelle mit den 3 Spalten
Hersteller Teilebezeichnug Anzahl die 1. Spalte mit der Überschrift Hersteller beginnt mit B4 Teilebezeichnung C4 und Anzahl D4 da die Tabelle sehr lang jetzt ist wollte ich die Tabelle umgestalten in folgende Form
beginnend mit B4 Hersteller die nächsten spalten sollen die 11 Teilearten sein bis M4 und M5 soll dann die Summe aus der Zeile ergeben.
Wie könnet man das mit enen VBA script lösen das aus der einen Tabelle die ander entsteht

Herstellername TeileName Anzahl
Meyer fle 5799
Meyer wdb 665
Meyer ufodb 50
Meyer dae 288
Meyer daeb 33
Müller fle 618
Müller wdb 1303
Müller lw 1850
Müller ufodb 98
Krüger fle 44
Krüger wdb 344
Krüger dae 490
Winter fle 1220
Winter ufodb 507
Winter dae 88
Winter rw 664
Winter smb 17

usw.

die Werte aus der Tabelle wollte ich in diese Tabelle umwandeln
Hersteller fle lw rw dae smb ufodb wdb ...... Summe

wer hätte da einen Tipp für mich.

Danke
VG
Tommhi
colinardo
colinardo 07.02.2014 aktualisiert um 10:10:32 Uhr
Goto Top
Hallo Tommhi,
das ist eindeutig ein Fall für eine Pivot-Tabelle, da brauchts kein Makro...
Übrigens, wo sollen denn die Mengen stehen ? unter den Artikeln ?
Grüße Uwe
tommhii
tommhii 07.02.2014 um 11:17:40 Uhr
Goto Top
Hallo Uwe,

die Anzahl der Teile sollen in der neuen Tabelle so eingetragen werden

Hersteller fle wdb dae ufodb......... summe
Müller 22 449 0 5234 5705
Meyer 0 18 122 0 ........ 140

kannst du mir da irgendwie weiterhelfen.

VG
Tommhi
colinardo
colinardo 07.02.2014 aktualisiert um 11:32:19 Uhr
Goto Top
wie schon gesagt eine Pivot-Tabele erledigt das mit 3 Klicks, die Leute wissen nur meistens nicht, wie diese anzuwenden sind ...

ed96ccf28ff66c037e8c8e4709d47f93

Demo-Pivot-Tabelle
tommhii
tommhii 08.02.2014 um 11:19:17 Uhr
Goto Top
Hallo Uwe,

danke erstmal mit dem Tip Pivot-Tabelle. Aber kann man das ganze nicht noch irgendwie automatisieren .
Ich möchte eine automatisierte Erstellung einer solchen Auswertung haben, damit dies auch jemand machen kann, der keine Ahnung von vba und Pivot-Tabelle etc. hat .

VG
Tommhii
colinardo
colinardo 08.02.2014 aktualisiert um 11:58:54 Uhr
Goto Top
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
tommhii
tommhii 08.02.2014 um 12:13:16 Uhr
Goto Top
danke dafür , aber was muss ich ändern wenn die Pivot-Tabelle in einen anderen Tabellenblatt entstehen soll.
colinardo
colinardo 08.02.2014 aktualisiert um 12:29:25 Uhr
Goto Top
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.
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
zwischendurch mal lesen schadet auch nicht:
back-to-topVBA/VBS/WSH/Office Developer Referenzen
tommhii
tommhii 10.02.2014 um 08:23:53 Uhr
Goto Top
Hallo Uwe,

danke für deine schnelle Hilfe.

VG
Tommhi
tommhii
tommhii 10.02.2014 aktualisiert um 15:04:38 Uhr
Goto Top
Hallo uwe,

ich habe den code bei mir eingebaut in Tabelle1 und versucht mittels eines aktiv Steuerelement Button zu starten, aber es kommt in Tabelle2 nur folgendes Bild.

In Tabelle 1 ist die erste Überschrift der Daten Tabelle in B4 und die Pivot Tabelle soll auch in B4 anfangen. Ich habe dies auch im Code angepast aber es geht nicht.

das erscheint in der Tabelle2

Auswertung
Klicken Sie in diesen Bereich, um den PivotTable-Bericht zu bearbeiten.

VG
Tommhi