Daten auslesen

Forumthread: Daten auslesen

Daten auslesen

06.08.2007 22:17:48

Hallo Freunde,
kann man aus diesem Makro eine Schleife machen?
https://www.herber.de/bbs/user/44801.xls


Sub Ausführen()
Application.Run "Löschen"
Application.Run "Jahr2004"
Application.Run "Jahr2005"
Application.Run "Jahr2006"
Application.Run "Jahr2007"
Application.Run "Jahr2008"
End Sub


Sub Löschen()
Range("B2:B10").Select
Selection.ClearContents
Range("C2:C10").Select
Selection.ClearContents
Range("D2:D10").Select
Selection.ClearContents
Range("E2:E10").Select
Selection.ClearContents
Range("F2:F10").Select
Selection.ClearContents
Range("B2").Select
End Sub


Sub Jahr2004()
Dim c As Variant
Dim X As Double
For X = 2 To 10
Cells(X, 2) = ""
For Each c In Worksheets("Jahr2004").Range("A2:A100")
If c.Value = Worksheets("Gesamt").Cells(X, 2).Offset(0, -1).Value Then Worksheets("Gesamt"). _
Cells(X, 2) = Worksheets("Gesamt").Cells(X, 2) & " " & c.Offset(0, 1).Value
Next
Next
End Sub


Sub Jahr2005()
Dim c As Variant
Dim X As Double
For X = 2 To 10
Cells(X, 3) = ""
For Each c In Worksheets("Jahr2005").Range("A2:A100")
If c.Value = Worksheets("Gesamt").Cells(X, 3).Offset(0, -2).Value Then Worksheets("Gesamt"). _
Cells(X, 3) = Worksheets("Gesamt").Cells(X, 3) & " " & c.Offset(0, 1).Value
Next
Next
End Sub


Sub Jahr2006()
Dim c As Variant
Dim X As Double
For X = 2 To 10
Cells(X, 4) = ""
For Each c In Worksheets("Jahr2006").Range("A2:A100")
If c.Value = Worksheets("Gesamt").Cells(X, 4).Offset(0, -3).Value Then Worksheets("Gesamt"). _
Cells(X, 4) = Worksheets("Gesamt").Cells(X, 4) & " " & c.Offset(0, 1).Value
Next
Next
End Sub


Sub Jahr2007()
Dim c As Variant
Dim X As Double
For X = 2 To 10
Cells(X, 5) = ""
For Each c In Worksheets("Jahr2007").Range("A2:A100")
If c.Value = Worksheets("Gesamt").Cells(X, 5).Offset(0, -4).Value Then Worksheets("Gesamt"). _
Cells(X, 5) = Worksheets("Gesamt").Cells(X, 5) & " " & c.Offset(0, 1).Value
Next
Next
End Sub


Sub Jahr2008()
Dim c As Variant
Dim X As Double
For X = 2 To 10
Cells(X, 6) = ""
For Each c In Worksheets("Jahr2008").Range("A2:A100")
If c.Value = Worksheets("Gesamt").Cells(X, 6).Offset(0, -5).Value Then Worksheets("Gesamt"). _
Cells(X, 6) = Worksheets("Gesamt").Cells(X, 6) & " " & c.Offset(0, 1).Value
Next
Next
End Sub

Wobei ich zwischen Einträge wie sie in Zelle B2 ( siehe "https://www.herber.de/bbs/user/44801.xls" )durch ein Komma getrennt sein sollen und wenn in A9 kein Eintrag ist soll auch in den daneben stehende Zellen kein Wert eingetragen werden.
Hoffe das mir irgend jemand hilft ;-))
Gruß
j. Bode

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten auslesen

07.08.2007 07:21:00

Beverly
AW: Daten auslesen

07.08.2007 07:31:00

ede
AW: Daten auslesen Korrektur

07.08.2007 07:43:38

ede
AW: Daten auslesen Korrektur

07.08.2007 08:59:00

J.
AW: Daten auslesen Korrektur

07.08.2007 15:45:00

J.
AW: Daten auslesen Korrektur

07.08.2007 16:34:17

Beverly
AW: Daten auslesen Korrektur

09.08.2007 14:13:00

J.

AW: Daten auslesen

07.08.2007 07:21:00

Beverly

Hi,
meinst du das vielleicht so


Sub Ausführen()
Dim inJahr As Integer
Dim c As Range
Dim X As Integer
Dim wsTabelle As Worksheet
Range("B2:F10").ClearContents
For Each wsTabelle In Worksheets
If Left(wsTabelle.Name, 4) = "Jahr" Then
With wsTabelle
For X = 2 To 10
For Each c In wsTabelle.Range("A2:A100")
If c  "" Then
If c.Value = Worksheets("Gesamt").Cells(X, 1).Value Then Worksheets( _
"Gesamt").Cells(X, 2) = Worksheets("Gesamt").Cells(X, 2) & ", " & c.Offset(0, 1).Value
End If
Next
Next
.Range("B2:B10") = ClearContents
End With
End If
Next wsTabelle
End Sub

________________________________________

AW: Daten auslesen

07.08.2007 07:31:00

ede

giten morgen bodo,
meinst du so:


Sub Ausführen()
Dim iJahr As Integer
Application.Run "Löschen"
For iJahr = 2004 To 2008
Call Jahre("Jahr" & iJahr, iJahr - 2002)
Next iJahr
End Sub


Sub Jahre(shName As String, iSpalte As Integer)
Dim c As Variant
Dim X As Double
For X = 2 To 10
Cells(X, iSpalte) = ""
For Each c In Worksheets(shName).Range("A2:A100")
If c.Value = Worksheets("Gesamt").Cells(X, iSpalte).Offset(0, iSpalte * -1 + 1).Value Then
Worksheets("Gesamt").Cells(X, iSpalte) = Worksheets("Gesamt").Cells(X, iSpalte) & " " & c. _
Offset(0, 1).Value
End If
Next
Next
End Sub

gruss

AW: Daten auslesen Korrektur

07.08.2007 07:43:38

ede

anbei nochmal eine korrektur, hatte das mit dem komma vergessen!


Sub Ausführen()
Dim iJahr As Integer
Application.Run "Löschen"
For iJahr = 2004 To 2008
Call Jahre("Jahr" & iJahr, iJahr - 2002)
Next iJahr
End Sub


Sub Jahre(shName As String, iSpalte As Integer)
Dim c As Variant
Dim X As Double
For X = 2 To 10
Cells(X, iSpalte) = ""
For Each c In Worksheets(shName).Range("A2:A100")
If c.Value = Worksheets("Gesamt").Cells(X, iSpalte).Offset(0, iSpalte * -1 + 1).Value Then
If Not IsEmpty(c.Value) And Not IsEmpty(c.Offset(0, 1).Value) Then
If Len(Worksheets("Gesamt").Cells(X, iSpalte)) > 0 Then
Worksheets("Gesamt").Cells(X, iSpalte) = Worksheets("Gesamt").Cells(X, iSpalte) & ", " _
& c.Offset(0, 1).Value
Else
Worksheets("Gesamt").Cells(X, iSpalte) = c.Offset(0, 1).Value
End If
End If
End If
Next
Next
End Sub

gruss

AW: Daten auslesen Korrektur

07.08.2007 08:59:00

Hallo Ihr zwei,
habt mir sehr geholfen.
Danke und einen schönen Tag

AW: Daten auslesen Korrektur

07.08.2007 15:45:00

Hallo, ich bins noch einmal.
Besteht die möglichkeit mir das Makro so zu erklären, mit Kommentare, das ich es auch nachvollziehen kann.
Denn VBA - Technisch habe ich keinen blassen Schimmer.
Danke im voraus für die Bemühungen.
Gruß ;-))

AW: Daten auslesen Korrektur

07.08.2007 16:34:17

Beverly

Hi,
hier mein Code mit Kommentaren. Ich hoffe, sie helfen dir weiter.


Sub Ausführen()
Dim inJahr As Integer
Dim c As Range                      ' Variable für die Suchzelle
Dim X As Integer                    ' Schleifenzähler
Dim wsTabelle As Worksheet          ' Variable für Tabelelnblatt als Objekt
' Bereich B2:F10 löschen
Range("B2:F10").ClearContents
' Schleife über alle Tabellen
For Each wsTabelle In Worksheets
' wenn die linken 4 Zeichen des Tabellennamens = "Jahr" sind
If Left(wsTabelle.Name, 4) = "Jahr" Then
' führe in der betreffenden Tabelle aus
With wsTabelle
' Schleife von 2 bis 10
For X = 2 To 10
' durchsuche alle Zellen der Tabelle im Bereich As:A100
For Each c In wsTabelle.Range("A2:A100")
' wenn die Zelle leer ist
If c  "" Then
' wenn die Zelle = der Zelle in Spalte 1 (A) der laufenden Zeile  _
dann
' Zelle in Spalte 1 (A) der laufenden Zeile = vorhandener Wert und " _
, " und Wert aus der Zelle rechts neben der gesuchten Zelle
' zusammensetzen
If c.Value = Worksheets("Gesamt").Cells(X, 1).Value Then Worksheets( _
_
"Gesamt").Cells(X, 2) = Worksheets("Gesamt").Cells(X, 2) & ", " & c.Offset(0, 1).Value
End If
Next
Next
' Bereich B2:B10 der laufenden Tabelle löschen
.Range("B2:B10") = ClearContents
End With
End If
Next wsTabelle
End Sub

Bis später,
Karin

AW: Daten auslesen Korrektur

09.08.2007 14:13:00

Hallo Beverly,
danke für Erklärung, nun bin ich ein Stück weiter.
Gruß

Beliebteste Forumthreads (12 Monate)

Forumthread: Daten auslesen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread