Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1060to1064
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

Bitte um Hilfe!

Bitte um Hilfe!
18.03.2009 08:14:33
Jan
Guten Tag miteinender
Also, zuerst möchte ich mal etwas vorweg nehmen: Ich habe mit VBA überhaupt nichts am Hut, brauche es aber unbedingt für meine Berechnungen. Jetzt wäre ich sehr glücklich, wenn ich mit eurer Hilfe folgendes Problem lösen kann.
Also, ich habe folgendes Sheet „Tabelle 1“.
__A_______B________C_________D__________E_______F_______G_________H_____
1
2
3________________Projekte__Entwicklung__Fehlaufträge__IBL__Int.Auftrge__Kudi ET__
4__Elektronik
5__Mechanik
6__Fertigung
7__Musterproduktion
8__Montage
Ziel ist es, dass ich in „Tabelle 2“ Daten einfügen kann, und dass dann die Tabelle in „Tabelle 1“ automatisch ausgefüllt wird.
Ich habe die einzelnen Schritte zusammengefasst und wäre froh, wenn mir jemand diese Schritte in die VBA-Sprache übersetzt.
Schritt 1:
Das Excel soll das Wort in C3 im Sheet „Tabelle 1“ auf dem Sheet „Tabelle 2“ suchen.
Schritt 2:
Wenn es dieses gefunden hat, soll es nach dem Wort in A4 von Sheet „Tabelle1“ im Sheet „Tabelle 2“ suchen und zwar dasjenige, welches am nächsten beim gefundenen Wort von Schritt 1 liegt, es muss aber nach unten gesucht werden (sprich, Excel soll nach dem nächstgelegenen Wort von Tabelle1!A4, welches aber unterhalb liegt. Hoffe Ihr wisst spätestens nach dem folgenden Beispiel, was ich mit Schritt 2 meine.
Das würde dann so aussehen:
Sheet „Tabelle2“
_A___________B________C________D________E________F________G____
Projekte
Mechanik______1___
Fertigung______4__
Elektronik_____7__
Jetzt müsste Excel das Wort Elektronik gefunden haben, da es zuerst nach dem Wort „Projekte“ gesucht hat, und dann das nächst weiter unten gelegene Wort, welches dem Wort von Tabelle1!A4 entspricht, nimmt.
Würde Sheet „Tabelle 2“ so aussehen:
_A___________B________C________D________E________F________G____
Elektronik
Projekte
Mechanik______1___
Fertigung______4__
Elektronik_____7__
, dann müsste Excel ebenfalls das untere Wort „Elektronik“ finden, obwohl das obere Wort näher beim in Schritt 1 gefundenen Wort „Projekte“ liegt. Weil das obere Wort „Elektronik“ nicht oberhalb des Wortes „Projekte“ liegt, und nicht unterhab!!, wird trotzdem das untere Wort genommen.
Schritt 3:
Excel soll den Wert, welcher sich eine Spalte weiter rechts vom gefundenen Wort befindet in die Zelle auf den Sheet „Tabelle 1“kopieren. Die Zelle in Sheet 1 wird folgendermassen ausgewählt: In der Spalte steht der Wert von C3 und in der Zeile der Wert von A4. Die Zelle, wo der Wert eingetragen hat, erfüllt beide Bedingungen und wäre somit die Zelle C4.
Schritt 4:
Excel soll diesen Prozess so weiterführen, bis alle Zellen (in diesem Beispiel: C4:H8 ) gefüllt sind.
Vielen Dank für eure Hilfe!
Jan

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bitte um Hilfe!
18.03.2009 08:18:47
dirk
Hallo Jan,
kannst Du mal Deine tabelle hochladen, damit man dazu ein Macro schreiben kann?
Danke und Gruss
Dirk aus Dubai
ist noch offen
18.03.2009 08:42:29
Jan
AW: ist noch offen
18.03.2009 10:34:21
dirk
Hallo Jan,
kopiere bitte folgendes Macro in den Codebereich fuer Tabelle2.
Du kannst einen Macroknopf zuordnen um das Macro manuell zu starten wannimmer Du eine Aenderung in Tabelle 2 aufnehmen willst.
Gruss
Dirk aus Dubai

Sub initial_data()
'Dieses Macro versorgt Tabelle1 mit den Daten aus Tabelle2
Dim SearchStr As String, lCount As Long, rFoundCell As Range
'erste Schleife bestimmt das erste Suchkriterium (Hauptgebiet z.b. Projekte)
For k = 1 To 6 '(6 Hauptgebiete in Tabelle1)
'Festlegen des Suchkriterium, feste Struktur in Tabelle1
SearchStr = Worksheets("Tabelle1").Cells(3, 2 + k).Value
Set rFoundCell = Sheets("Tabelle2").Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), SearchStr)
Set rFoundCell = Columns(1).Find(What:=SearchStr, After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
foundaddress = rFoundCell.Address
Next lCount
'naechste Schleife bestimmt das 2te Suchkriterium (Untergruppe)
For m = 1 To 5 '(5 Untergruppen in Tabelle1)
'suche nach unten in der Tabelle nach dem Wert aus Tabelle1
searchstr2 = Sheets("Tabelle1").Cells(3 + m, 1).Value
lastrow = Sheets("Tabelle2").Cells(Rows.Count, rFoundCell.Column).End(xlUp).Row 'letzte  _
Reihe bestimmen
For i = rFoundCell.Row To lastrow
If Cells(1 + i, rFoundCell.Column).Value = searchstr2 Then
Sheets("Tabelle1").Cells(3 + m, 2 + k).Value = Sheets("Tabelle2").Cells(1 + i, 3). _
Value
i = lastrow
End If
Next i
Next m
Next k
End Sub


Anzeige
AW: ist noch offen
18.03.2009 10:42:55
Jan
Vielen, vielen Dank Dirk..Da hast du dir aber Mühe gegeben. Bin dir sowas von dankbar, echt!:)
Hätte da aber noch eine kleine Frage, da ich mich wie gesagt nicht so mit VBA auskenne:
Kann man da in noch mehr Spalten hinzufügen, sprich bei Projekte, Entwicklung...
Das Makro funktioniert super, aber wenn ich eine Spalte hinzufüge, die kennt er nicht..
AW: ist noch offen
18.03.2009 10:51:07
dirk
Hallo Jan,
schau mal in Zeile 7: For k = 1 To 6 '(6 Hauptgebiete in Tabelle1)
In dieser Zeile aenderst Du den Schleifendurchlauf fuer alle Hauptgruppen (Spalten).
Falls Du also 10 Spalten hast mit Namen (z.B. Projekte, Entwicklung...) muss hier For K = 1 to 10 stehen.
Dasselbe auch in in der Suchschleife fuer die Untergruppen. Falls Du da mehr untergruppen brauchst, einfach den Schleifenzaehler erhoehen.
Ich hoffe das hilft Dir weiter.
Gruesse
Dirk aus Dubai
Anzeige
AW: ist noch offen
18.03.2009 10:59:06
Jan
geht super..:) vielen Dank Dirk und noch einen schönen und warmen Tag.:)
AW: Bitte um Hilfe!
18.03.2009 11:07:04
Jan
noch eine allerletzte Frage an dich Dirk:
wenn jetzt auf Tabelle 2 das Hauptgebiet in Spalte 1, die Untergruppe in Spalte 2 und der Wert in Spalte 3 steht, was muss ich dann ändern?
Momentan ist ja das Hauptgebiet und Spalte 1; Untergruppe ebenfalls in Spalte 1 und der Wert in Spalte 3.
AW: Bitte um Hilfe!
18.03.2009 11:19:09
serge
Hallo Jan
kann dir das ohne VBA helfen?

Die Datei https://www.herber.de/bbs/user/60412.xls wurde aus Datenschutzgründen gelöscht


Gruss serge
Anzeige
AW: Bitte um Hilfe!
18.03.2009 11:30:22
Thomas
Hallo Serge
Auch dir vielen Dank für deine Hilfe.
Dies würde funktionieren, wenn dies auch funktionieren würde.
https://www.herber.de/bbs/user/60413.xls
es tut mir leid, ich habe es vergessen, in meiner Vorlage so darzustellen.
AW: Bitte um Hilfe!
18.03.2009 11:40:54
Thomas
AW: Bitte um Hilfe!
20.03.2009 11:46:10
Jonas
wie müsste ich dieses makro anpassen, wenn meine tabelle so aussehen würde: spalte A Projekte, Spalte B leer, Spalte C Untertitel (Konstruktion usw.) Spate D leer, Spalte E Preise?
sprich es gibt noch 2 zwischenspalten mehr...

Sub initial_data()
'Dieses Macro versorgt Tabelle1 mit den Daten aus Tabelle2
Dim SearchStr As String, lCount As Long, rFoundCell As Range
'erste Schleife bestimmt das erste Suchkriterium (Hauptgebiet z.b. Projekte)
For k = 1 To 8 '(6 Hauptgebiete in Tabelle1)
'Festlegen des Suchkriterium, feste Struktur in Tabelle1
SearchStr = Worksheets("Tabelle1").Cells(3, 2 + k).Value
Set rFoundCell = Sheets("Tabelle2").Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), SearchStr)
Set rFoundCell = Columns(1).Find(What:=SearchStr, After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
foundaddress = rFoundCell.Address
Next lCount
'naechste Schleife bestimmt das 2te Suchkriterium (Untergruppe)
For m = 1 To 5 '(5 Untergruppen in Tabelle1)
'suche nach unten in der Tabelle nach dem Wert aus Tabelle1
searchstr2 = Sheets("Tabelle1").Cells(3 + m, 1).Value
lastrow = Sheets("Tabelle2").Cells(Rows.Count, rFoundCell.Column + 1).End(xlUp).Row ' _
letzte _
Reihe bestimmen
For i = rFoundCell.Row To lastrow
If Cells(1 + i, rFoundCell.Column + 1).Value = searchstr2 Then
Sheets("Tabelle1").Cells(3 + m, 2 + k).Value = Sheets("Tabelle2").Cells(1 + i,  _
_
3). _
Value
i = lastrow
End If
Next i
Next m
Next k
End Sub


Anzeige
AW: Bitte um Hilfe!
20.03.2009 11:46:25
Jonas
wie müsste ich dieses makro anpassen, wenn meine tabelle so aussehen würde: spalte A Projekte, Spalte B leer, Spalte C Untertitel (Konstruktion usw.) Spate D leer, Spalte E Preise?
sprich es gibt noch 2 zwischenspalten mehr...

Sub initial_data()
'Dieses Macro versorgt Tabelle1 mit den Daten aus Tabelle2
Dim SearchStr As String, lCount As Long, rFoundCell As Range
'erste Schleife bestimmt das erste Suchkriterium (Hauptgebiet z.b. Projekte)
For k = 1 To 8 '(6 Hauptgebiete in Tabelle1)
'Festlegen des Suchkriterium, feste Struktur in Tabelle1
SearchStr = Worksheets("Tabelle1").Cells(3, 2 + k).Value
Set rFoundCell = Sheets("Tabelle2").Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), SearchStr)
Set rFoundCell = Columns(1).Find(What:=SearchStr, After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
foundaddress = rFoundCell.Address
Next lCount
'naechste Schleife bestimmt das 2te Suchkriterium (Untergruppe)
For m = 1 To 5 '(5 Untergruppen in Tabelle1)
'suche nach unten in der Tabelle nach dem Wert aus Tabelle1
searchstr2 = Sheets("Tabelle1").Cells(3 + m, 1).Value
lastrow = Sheets("Tabelle2").Cells(Rows.Count, rFoundCell.Column + 1).End(xlUp).Row ' _
letzte _
Reihe bestimmen
For i = rFoundCell.Row To lastrow
If Cells(1 + i, rFoundCell.Column + 1).Value = searchstr2 Then
Sheets("Tabelle1").Cells(3 + m, 2 + k).Value = Sheets("Tabelle2").Cells(1 + i,  _
_
3). _
Value
i = lastrow
End If
Next i
Next m
Next k
End Sub


Anzeige
AW: Bitte um Hilfe!
20.03.2009 15:11:08
jonas
hat sich geklärt..:)
AW: Bitte um Hilfe!
18.03.2009 11:50:28
dirk
Hallo Jan,
sollte gehen, wenn Du fuer die zweite Schleife (Untergruppe) den Wert nach dem Komma in Cells() auf die Spalte setzt:
searchstr2 = Sheets("Tabelle1").Cells(3 + m, 2).Value
Gruss
Dirk aus Dubai
AW: Bitte um Hilfe!
18.03.2009 12:01:23
dirk
Sorry!
War etwas zu schnell. Hier der richtige Ansatz. Du musst die folgenden zwei Zeilen entsprechend aendern.
lastrow = Sheets("Tabelle2").Cells(Rows.Count, rFoundCell.Column+1).End(xlUp).Row 'letzte _
Reihe bestimmen
For i = rFoundCell.Row To lastrow
If Cells(1 + i, rFoundCell.Column+1).Value = searchstr2 Then
Hier das angepasste Macro.
Gruss
Dirk aus Dubai

Sub initial_data()
'Dieses Macro versorgt Tabelle1 mit den Daten aus Tabelle2
Dim SearchStr As String, lCount As Long, rFoundCell As Range
'erste Schleife bestimmt das erste Suchkriterium (Hauptgebiet z.b. Projekte)
For k = 1 To 6 '(6 Hauptgebiete in Tabelle1)
'Festlegen des Suchkriterium, feste Struktur in Tabelle1
SearchStr = Worksheets("Tabelle1").Cells(3, 2 + k).Value
Set rFoundCell = Sheets("Tabelle2").Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), SearchStr)
Set rFoundCell = Columns(1).Find(What:=SearchStr, After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
foundaddress = rFoundCell.Address
Next lCount
'naechste Schleife bestimmt das 2te Suchkriterium (Untergruppe)
For m = 1 To 5 '(5 Untergruppen in Tabelle1)
'suche nach unten in der Tabelle nach dem Wert aus Tabelle1
searchstr2 = Sheets("Tabelle1").Cells(3 + m, 1).Value
lastrow = Sheets("Tabelle2").Cells(Rows.Count, rFoundCell.Column+1).End(xlUp).Row ' _
letzte  _
Reihe bestimmen
For i = rFoundCell.Row To lastrow
If Cells(1 + i, rFoundCell.Column+1).Value = searchstr2 Then
Sheets("Tabelle1").Cells(3 + m, 2 + k).Value = Sheets("Tabelle2").Cells(1 + i,  _
3). _
Value
i = lastrow
End If
Next i
Next m
Next k
End Sub


Anzeige
AW: Bitte um Hilfe!
18.03.2009 12:55:58
Jan
Entschuldigung, dass ich erst jetzt antworte, aber ich wollte dir noch mitteilen, dass ich jetzt vollkommen zufrieden bin. Vielen Dank euch beiden und vor allem dir Dirk. Super Sache!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige