Microsoft Excel

Herbers Excel/VBA-Archiv

Daten aus Spalte auslesen und dazugehörige Namen a

Betrifft: Daten aus Spalte auslesen und dazugehörige Namen a von: Christoph S.
Geschrieben am: 22.04.2015 19:20:58

Hallo,



ich bin neu hier und habe eine Frage zu einem Problem bezüglich VBA. Mein Wissensstand zu VBA hält sich auch in Grenzen...

Mein Problem ist:

Ich habe zwei Spalten, in der einen Stehen normale Namen, und in der anderen verschiedene Typen, welche durch Bindestriche getrennt sind. Formal sieht es so aus:

Spalte 1 Spalte 2

Name 1 WSSDR-FSRS-Q2U

Name 2 WSSDR-KL1L-Ro1_2

Name 3 Ro1_2-WSSDM-WSSDR-FSRS-FSLS

Das Makro, welches ich programmieren muss, muss den verschiedenen Typen aus Spalte 2 die Namen aus Spalte 1 zuweisen....also:

WSSDR enthält: Name 1, Name 2, Name 3

FSRS enthält: Name 1, Name 3

Q2U enthält: Name 1

Kl1L enthält: Name 2

Ro1_2 enthält: Name 2, Name 3

usw......



Wie sieht der Programmtext bzw. das fertige VBA-Programm hierfür aus?

Ich bitte um Hilfe!

Vielen Dank im Voraus!



Mit freundlichen Grüßen
Christoph S.

  

Betrifft: AW: Daten aus Spalte auslesen und dazugehörige Namen a von: Uduuh
Geschrieben am: 22.04.2015 20:29:58

Hallo,
Daten ab A1:

Sub Namen()
  Dim objTyp As Object, vArr, vTmp, i As Long, j As Integer
  Set objTyp = CreateObject("scripting.dictionary")
  vArr = Range(Cells(1, 1), Cells(Rows.Count, 2).End(xlUp))
  For i = 1 To UBound(vArr)
    vTmp = Split(vArr(i, 2), "-")
      For j = 0 To UBound(vTmp)
        If objTyp.exists(vTmp(j)) Then
          objTyp(vTmp(j)) = objTyp(vTmp(j)) & ", " & vArr(i, 1)
        Else
          objTyp(vTmp(j)) = vArr(i, 1)
        End If
      Next
  Next
  With Worksheets.Add
    .Cells(1, 1).Resize(objTyp.Count) = WorksheetFunction.Transpose(objTyp.keys)
    .Cells(1, 2).Resize(objTyp.Count) = WorksheetFunction.Transpose(objTyp.items)
  End With
End Sub
Ergebnis wird in ein neues Blatt geschrieben.

Gruß aus’m Pott
Udo



  

Betrifft: AW: Daten aus Spalte auslesen und dazugehörige Namen a von: Christoph S.
Geschrieben am: 22.04.2015 20:56:30

Vielen Dank für die sehr schnelle Antwort. Das Problem ist jetzt nur, dass es die Typen (WSSDR, FSRS usw.) in dem neuen Blatt alle untereinander auflistet, jedoch ohne mir die enthaltenen Namen auszugeben.
Es erscheint die Meldung "Laufzeitfehler 13. Typen unverträglich."
Kann es sein, dass meine "Namen" in Spalte 1 nicht wirklich immer "Name 1", "Name 2" usw. heißen, sonder "4748B6", "8952C1" usw.?

Mit freundlichen Grüßen
Christoph S.


  

Betrifft: Namen zuodrnen von: Peter Feustel
Geschrieben am: 22.04.2015 21:45:05

Hallo Christoph

das liegt daran, dass du wahrscheinlich das Makro aus dem Ergebnis-Tabellenblatt gestartet hast.
Ändere an dieser Stelle das Makro, dann sollte das Thema erledigt sein:

With ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
      vArr = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
   End With

Gruß Peter


  

Betrifft: AW: Namen zuodrnen von: Christoph S.
Geschrieben am: 22.04.2015 22:05:06

Hallo Peter,

mein Programmtext lautet nun also:

Sub Namen()
  Dim objTyp As Object, vArr, vTmp, i As Long, j As Integer
  Set objTyp = CreateObject("scripting.dictionary")
  vArr = Range(Cells(1, 1), Cells(Rows.Count, 2).End(xlUp))
  For i = 1 To UBound(vArr)
    vTmp = Split(vArr(i, 2), "-")
      For j = 0 To UBound(vTmp)
        If objTyp.exists(vTmp(j)) Then
          objTyp(vTmp(j)) = objTyp(vTmp(j)) & ", " & vArr(i, 1)
        Else
          objTyp(vTmp(j)) = vArr(i, 1)
        End If
      Next
  Next
 With ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
      vArr = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
   End With
End Sub
Wenn ich das so eingebe, kommt keine Fehlermeldung mehr beim Ausführen, jedoch passiert auch nichts innerhalb der Tabellen.

Mit freundlichen Grüßen
Christoph Sauer


  

Betrifft: Daten aus Spalte auslesen und dazugehörige Namen a von: Rudi Maintaire
Geschrieben am: 23.04.2015 10:24:41

Hallo,
probier mal

Sub Namen()
  Dim objTyp As Object, vArr, vTmp, i As Long, j As Integer
  Set objTyp = CreateObject("scripting.dictionary")
  
  With Worksheets("RohDaten") 'anpassen
    vArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp))
  End With
  
  For i = 1 To UBound(vArr)
    vTmp = Split(vArr(i, 2), "-")
      For j = 0 To UBound(vTmp)
        If objTyp.exists(vTmp(j)) Then
          objTyp(vTmp(j)) = objTyp(vTmp(j)) & ", " & vArr(i, 1)
        Else
          objTyp(vTmp(j)) = vArr(i, 1)
        End If
      Next
  Next
  
  With Worksheets("Ausgabe") 'anpassen
      .Cells(1, 1).Resize(objTyp.Count) = WorksheetFunction.Transpose(objTyp.keys)
      .Cells(1, 2).Resize(objTyp.Count) = WorksheetFunction.Transpose(objTyp.items)
  End With
  
End Sub
Ansonsten Beispielmappe hochladen.

Gruß
Rudi


  

Betrifft: AW: Daten aus Spalte auslesen und dazugehörige Namen a von: Christoph S.
Geschrieben am: 23.04.2015 10:51:23

Hallo Rudi,

vielen Dank für die Hilfe, doch leider funktioniert es immer noch nicht.

Hier die Beispielmappe, bei der genau dieses Problem gelöst werden muss:
https://www.herber.de/bbs/user/97260.xlsx


Mit freundlichen Grüßen
Christoph


  

Betrifft: Daten aus Spalte auslesen und dazugehörige Namen a von: Rudi Maintaire
Geschrieben am: 23.04.2015 11:25:53

Hallo,
auf deine Mappe zugeschnitten:

Sub Namen()
  Dim objTyp As Object, vArr, vTmp, i As Long, j As Integer
  Set objTyp = CreateObject("scripting.dictionary")
  
  With Worksheets("Tabelle1")
    vArr = .Range(.Cells(4, 1), .Cells(.Rows.Count, 2).End(xlUp))
  End With
  
  For i = 1 To UBound(vArr)
    vTmp = Split(vArr(i, 2), "-")
      For j = 0 To UBound(vTmp)
        If objTyp.exists(vTmp(j)) Then
          objTyp(vTmp(j)) = objTyp(vTmp(j)) & ", " & vArr(i, 1)
        Else
          objTyp(vTmp(j)) = vArr(i, 1)
        End If
      Next
  Next
  
  With Worksheets("tabelle2")
      .Cells(1, 1).Resize(objTyp.Count) = WorksheetFunction.Transpose(objTyp.keys)
      .Cells(1, 2).Resize(objTyp.Count) = WorksheetFunction.Transpose(objTyp.items)
  End With
  
End Sub

Gruß
Rudi


  

Betrifft: AW: Daten aus Spalte auslesen von: Peter Feustel
Geschrieben am: 23.04.2015 11:28:07

Hallo Christoph,

so, wie im Anhang sollte es funktionieren

Gruß Peter

https://www.herber.de/bbs/user/97261.xlsm


  

Betrifft: AW: Daten aus Spalte auslesen von: Christoph S.
Geschrieben am: 23.04.2015 20:59:01

Hallo Rudi,

vielen Dank für die Lösung.
...Meine Tabelle sieht eigentlich 1 zu 1 so aus, wie das Beispiel, nur mit viel mehr Zeilen. Komischerweise funktioniert das Makro bei der originalen Tabelle zum Teil nicht, d.h., wenn ich ca. die Hälfte der Zeilen rauslösche, dann funktioniert alles perfekt...aber eben nicht für die gesamt Tabelle.
Es wird wieder "Laufzeitfehler 13. Typen unverträglich" angezeigt.

Was muss ich tun?
Vielen Dank für die Unterstützung.

Mit freundlichen Grüßen
Christoph


  

Betrifft: AW: Daten aus Spalte auslesen von: Rudi Maintaire
Geschrieben am: 24.04.2015 12:21:27

Hallo,
nur mit viel mehr Zeilen
wie viele?

Gruß
Rudi


  

Betrifft: AW: Daten aus Spalte auslesen von: Christoph S.
Geschrieben am: 24.04.2015 13:36:41

Hallo,

insgesamt sind es 1470; und wenn ich die Zeilen herausfiltere, bei den etwas in der 1. Spalte steht, aber kein dazugehöriger Typ in der zweiten, dann sind es 387.

Mit freundlichen Grüßen
Christoph


  

Betrifft: AW: Daten aus Spalte auslesen von: Rudi Maintaire
Geschrieben am: 24.04.2015 13:49:38

Hallo,
keine Ahnung, was es sein könnte.
Fehlerwerte vorhanden?

Gruß
Rudi


 

Beiträge aus den Excel-Beispielen zum Thema "Daten aus Spalte auslesen und dazugehörige Namen a"