Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1000to1004
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabelle mit Daten aus zweiter Tabelle ergänzen

Tabelle mit Daten aus zweiter Tabelle ergänzen
19.08.2008 19:49:00
Fritz_W
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

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelle mit Daten aus zweiter Tabelle ergänzen
19.08.2008 20:22:27
Daniel
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

Anzeige
AW: Tabelle mit Daten aus zweiter Tabelle ergänzen
19.08.2008 20:33:00
Fritz_W
Hallo Daniel,
funktioniert wie gewünscht.
Vielen Dank!
mfg
Fritz

AW: Beispielmappe?
19.08.2008 20:23:00
Erich
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

AW: Beispielmappe?
19.08.2008 20:41:00
Fritz_W
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

Anzeige
AW: Beispielmappe?
19.08.2008 21:03:00
Erich
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

Anzeige
AW: Beispielmappe?
19.08.2008 21:24:01
Fritz_W
Hallo Erich,
ganz toll, vielen Dank!
mfg
Fritz

Änderungen (mit Beispielmappe) @Daniel u. Erich G.
20.08.2008 13:47:00
Fritz_W
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

Anzeige
AW: Änderungen
20.08.2008 17:29:48
Erich
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

Anzeige
AW: Änderungen
20.08.2008 18:05:15
Fritz_W
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

318 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige