Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Tabelle mit Daten aus zweiter Tabelle ergänzen

Betrifft: Tabelle mit Daten aus zweiter Tabelle ergänzen von: Fritz_W
Geschrieben am: 19.08.2008 19:49:18

Hallo VBA-Experten,

die nachfolgend dargestellte Tabelle "Statistik" möchte ich entsprechend der Daten aus der Tabelle "Daten" Bereich E3:E52 jeweils wie nachfolgend beschrieben erweitern:
In der Tabelle "Daten" können im Bereich E3:E52 bis zu 50 Namen stehen.
Das Makro soll diese Namen - sofern sie in der Tabelle Statistik in der Spalte C nicht stehen, jeweils an diese Namensliste anfügen, beginnend ab der ersten freien Zelle. Für jeden angefügten Namen soll in der Spalte deren "Überschrift" in Zeile 2 identisch ist mit dem Eintrag in Zelle C1 ist, ein "x" eingetragen werden. Das gleiche soll bei den Namen geschehen, die vorher bereits in der Spalte C enthalten waren, sofern sie in der Tabelle Daten im Bereich E3:E52 enthalten sind.

Ich hoffe, ich habe mein Anliegen nachvollziehbar beschrieben und bedanke mich im Voraus für eure Unterstützung.

mfg
Fritz

Statistik

 CDEFGHIJKLMNOPQRST
108/09                 
2Name, Vorname98/9999/0000/0101/0202/0303/0404/0505/0606/0707/0808/0909/1010/1111/1212/1313/1414/15
3Grau, Siegfriedx                
4Braun, Helmutxx x x xx        
5Weiss, Elvirax x x  xxx       
6Roth, Didi x x xxxxx       
7Schwarz, Biancax x    xxx       
8Blau, Horst      xxxx       
9Groß, Herbertx x xx  xx       
10Klein, Kurtx x   xxxx       
11Lang, Helga x     x x       
12Hoch, Peter   xx  xxx       
13                  


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

  

Betrifft: AW: Tabelle mit Daten aus zweiter Tabelle ergänzen von: Daniel
Geschrieben am: 19.08.2008 20:22:27

HI

so vielleicht:

Sub eintragen()
Dim Zelle As Range
Dim rngDaten As Range
Dim sp As Long

Set rngDaten = Sheets("Daten").Range("E3:E52")

With Sheets("Statistik")
For Each Zelle In rngDaten
   If Zelle.Value <> "" Then
        If WorksheetFunction.CountIf(.Range("C:C"), Zelle.Value) = 0 Then
            .Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = Zelle.Value
        End If
    End If
Next

sp = .Rows(2).Find(what:=.Range("C1").Value).Column
For Each Zelle In Range(.Cells(3, 3), .Cells(Rows.Count, 3).End(xlUp))
    If WorksheetFunction.CountIf(rngDaten, Zelle.Value) > 0 Then
      .Cells(Zelle.Row, sp).Value = "x"
    End If
Next

End With
End Sub




Gruß, Daniel


  

Betrifft: AW: Tabelle mit Daten aus zweiter Tabelle ergänzen von: Fritz_W
Geschrieben am: 19.08.2008 20:33:26

Hallo Daniel,

funktioniert wie gewünscht.
Vielen Dank!

mfg
Fritz


  

Betrifft: AW: Beispielmappe? von: Erich G.
Geschrieben am: 19.08.2008 20:23:58

Hi Fritz,
um so etwas zu programmieren und zu testen, braucht man eine Beispielmappe.
In der Darstellung hier sieht man nur, wie die Tabelle "Statistik" aussieht,
aber keine "Feinheiten" wie echte Zellinhalte, Formate usw.

Damit nicht jeder, der sich daran versuchen will, für sich eine Beispielmappe bauen muss,
wäre es sicher sinnvoll, du würdest eine solche Mappe für alle hochladen.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Beispielmappe? von: Fritz_W
Geschrieben am: 19.08.2008 20:41:07

Hallo Erich,

du hast Recht, vielen Dank für den Hinweis.
Daniels Makro genügt soweit meinen Anforderungen.
Man könnte höchstens noch berücksichtigen, dass das Makro einfach nicht ausgeführt wird oder noch besser einen entsprechenden Hinweis liefert, wenn in der Spalte 2 kein Eintrag gefunden wird, der dem Eintrag in der Zelle C1 entspricht.

Gruß und nochmals vielen Dank.

Fritz


  

Betrifft: AW: Beispielmappe? von: Erich G.
Geschrieben am: 19.08.2008 21:03:18

Hi Fritz,
mit dem gewünschten Hinweis:

Option Explicit

Sub Eintragen2()
   Dim rngN As Range, lngLZ As Long, lngSp As Long, rngF As Range

   With Sheets("Statistik")
      lngLZ = .Cells(Rows.Count, 3).End(xlUp).Row     ' letzte Zeile Statistik

      Set rngF = .Rows(2).Find(.Range("C1"), After:=Cells(2, 3), _
         LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False)
      If rngF Is Nothing Then
         MsgBox "Eintrag '" & Range("C1") & "' nicht gefunden in Zeile 2.", _
            vbCritical, "Abbruch"
         Exit Sub
      Else
         lngSp = rngF.Column                          ' zu belegende Spalte
      End If

      For Each rngN In Sheets("Daten").Range("E3:E52")
         If rngN > "" Then
            Set rngF = .Columns(3).Find(rngN, After:=Cells(2, 3), _
               LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, _
               SearchFormat:=False)
            If rngF Is Nothing Then                   ' neue Zeile in Statistik
               lngLZ = lngLZ + 1
               Set rngF = .Cells(lngLZ, 3)
               rngF = rngN                            ' Eintrag Name
            End If
            .Cells(rngF.Row, lngSp) = "x"             ' Eintrag "x"
         End If
      Next
   End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Beispielmappe? von: Fritz_W
Geschrieben am: 19.08.2008 21:24:01

Hallo Erich,

ganz toll, vielen Dank!

mfg
Fritz


  

Betrifft: Änderungen (mit Beispielmappe) @Daniel u. Erich G. von: Fritz_W
Geschrieben am: 20.08.2008 13:47:33

Hallo VBA-Profis,

in die Tabelle "Statistik" sollte (anstatt "x") der jeweilige Wert aus der Spalte F der Datei "Daten" übernommen werden. Leider bin ich bei der Umsetzung dieses Vorhabens überfordert und hoffe erneut eure Hilfe. In der Beispielmappe wird mein Anliegen (hoffentlich) nachvollziebar. Tabelle "Statistik" stellt die derzeitige Ausgangssituation dar. In der Tabelle "Statistik_Lö1" habe ich die Tabelle "Statistik" nach Ausführung der vorliegenden Makros wiedergegeben. Tabelle "Statistik_Lö2": So sollte Tabelle "Statistik" nach Ausführung des nun gewünschten Codes aussehen.

Im Voraus besten Dank für jede Form von Hilfe.

mfg
Fritz

https://www.herber.de/bbs/user/54754.xls


  

Betrifft: AW: Änderungen von: Erich G.
Geschrieben am: 20.08.2008 17:29:48

Hi Fritz,
in Eintragen2 war nur die Zeile mit dem "x" zu ändern.
Daniels Version arbeitet an der Stelle nur mit CountIf - da müsste man jetzt die Zeile mit dem Namen
noch bestimmen (oder den Zahlenwert per VLOOKUP o.ä.).

Dazu noch eine Eintragen3, die nicht mit Find, sondern mit Match (VERGLEICH) arbeitet.
Ist noch ein wenig einfacher:

Sub Eintragen2()
   Dim rngN As Range, lngLZ As Long, lngSp As Long, rngF As Range

   With Sheets("Statistik")
      lngLZ = .Cells(Rows.Count, 3).End(xlUp).Row     ' letzte Zeile Statistik

      Set rngF = .Rows(2).Find(.Range("C1"), After:=Cells(2, 3), _
         LookIn:=xlValues, LookAt:=xlWhole, SearchFormat:=False)
      If rngF Is Nothing Then
         MsgBox "Eintrag '" & Range("C1") & "' nicht gefunden in Zeile 2.", _
            vbCritical, "Abbruch"
         Exit Sub
      Else
         lngSp = rngF.Column                          ' zu belegende Spalte
      End If

      For Each rngN In Sheets("Daten").Range("E3:E52")
         If rngN > "" Then
            Set rngF = .Columns(3).Find(rngN, After:=Cells(2, 3), _
               LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, _
               SearchFormat:=False)
            If rngF Is Nothing Then                   ' neue Zeile in Statistik
               lngLZ = lngLZ + 1
               Set rngF = .Cells(lngLZ, 3)
               rngF = rngN                            ' Eintrag Name
            End If
            .Cells(rngF.Row, lngSp) = rngN.Offset(, 1) ' Eintrag Wert zu Name
         End If
      Next
   End With
End Sub

Sub Eintragen3()
   Dim rngN As Range, lngLZ As Long, lngSp As Long, varZ As Variant

   With Sheets("Statistik")
      lngLZ = .Cells(Rows.Count, 3).End(xlUp).Row     ' letzte Zeile Statistik

      varZ = Application.Match(.Range("C1"), .Rows(2), 0)
      If IsError(varZ) Then
         MsgBox "Eintrag '" & Range("C1") & "' nicht gefunden in Zeile 2.", _
            vbCritical, "Abbruch"
         Exit Sub
      Else
         lngSp = varZ                                 ' zu belegende Spalte
      End If

      For Each rngN In Sheets("Daten").Range("E3:E52")
         If rngN > "" Then
            varZ = Application.Match(rngN, .Columns(3), 0)
            If IsError(varZ) Then                     ' neue Zeile in Statistik
               lngLZ = lngLZ + 1
               varZ = lngLZ
               .Cells(varZ, 3) = rngN                 ' Eintrag Name
            End If
            .Cells(varZ, lngSp) = rngN.Offset(, 1)    ' Eintrag Wert zu Name
         End If
      Next
   End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Änderungen von: Fritz_W
Geschrieben am: 20.08.2008 18:05:15

Hallo Erich,

super, vielen Dank!

Machst Dir zusätzliche Mühe und bietest gleich eine alternative Lösung an. Dazu Erläuterungen und Kommentare im Code, einfach toll!
Im Namen aller die von solchen Hilfen viel Nutzen haben nochmaligen Dank!

Gruß
Fritz


 

Beiträge aus den Excel-Beispielen zum Thema "Tabelle mit Daten aus zweiter Tabelle ergänzen"