Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
948to952
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
948to952
948to952
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Werte mit VBA kopieren

Werte mit VBA kopieren
13.02.2008 11:01:00
markus473
Hallo zusammen,
ich habe folgendes Makro (siehe Tabelle), welches aus meiner Tabelle das Blatt Statistik nach der Spalte "Nummer"
auswertet und in die Spalten "Gruppe" und "Summe" der dazugehörigen Blätter übernimmt.
Das ganze ist so, dass ich immer wieder neue Werte in das Blatt Statistik
kopieren werden, und diese dann immer wieder im dazugehörigen Blatt in die nächste frei
Spalte übernommen werden.
Jetzt habe ich folgendes Problem, das ich nur die Gruppen übernehmen möchte, welche ich im Blatt Statistik Spalte I vorgebe.
Das funktioniert leider nur im Blatt 810, woran liegt das?
https://www.herber.de/bbs/user/49885.xls
Danke für Eure Hilfe.
Gruß Markus

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte mit VBA kopieren
13.02.2008 16:13:00
fcs
Hallo Markus,
ich hab mal in das Makro reingesehen und die Struktur vereinfacht. Meiner meinung nach muss für die jeweils gefundenen Zeile für die Gruppe die nächste freie Spalte gesucht werden, sonnst werden ggf. Zellwerte beim nächsten Durchlauf überschrieben, wenn in Zeile 5 kein Eintrag vorhanden ist.
Gruß
Franz

Public Sub Kopierenorg()
Dim WkSh_Q       As Worksheet  ' das Quell-Tabellenblatt - Statistik
Dim WkSh_Z       As Worksheet  ' das Ziel-Tabellenblatt - wird dynamisch festgelegt
Dim lZeile_Q     As Long       ' For/Next Schleifen-Index der Zeile im Quell-Blatt
Dim iSpalte      As Integer    ' For/Next Schleifen-Index der Spalten
Dim sSuchbegr    As String     ' der Suchbegriff - hier die Gruppe
Dim rZelle       As Range      ' die Zelle in der die Gruppe gefunden wurde / oder nicht
Application.ScreenUpdating = False   ' kein Bildschirm-Update während des Makro-Laufs
Set WkSh_Q = Worksheets("Statistik") ' das Quell-Tabellenblatt festlegen
For lZeile_Q = 2 To WkSh_Q.Cells(Rows.Count, 2).End(xlUp).Row
Set WkSh_Z = Nothing
sSuchbegr = WkSh_Q.Cells(lZeile_Q, 2).Value ' die Gruppe als Suchbegriff speichern
'Zieltabelle gemäß Nummer setzen
Select Case WkSh_Q.Cells(lZeile_Q, 5).Value ' die Nummer als Case auswerten
Case 810                    ' ist es die Nummer für Tabellenblatt 810 ?
Set WkSh_Z = Worksheets("810")
Case 815                    ' ist es die Nummer für Tabellenblatt 815 ?
Set WkSh_Z = Worksheets("815")
Case 820                    ' ist es die Nummer für Tabellenblatt 820 ?
Set WkSh_Z = Worksheets("820")
End Select
If Not WkSh_Z Is Nothing Then
With WkSh_Z.Columns(2) ' im Blatt die Spalte 2 = B festlegen
'                 in der Spalte 2 = B nach der Gruppe suchen
Set rZelle = .Find(sSuchbegr, LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then ' wurde die Gruppe gefunden ?
For iSpalte = 3 To 256               ' die erste freie Spalte in Zeile im Blatt  _
finden
If WkSh_Z.Cells(rZelle.Row, iSpalte) = "" Then ' ist die Zelle für Gruppe leer  _
Exit For                       ' und die For/Next Schleife verlassen
End If
Next iSpalte                         ' die nächste Spalte heranziehen
'                    die Summe übertragen
WkSh_Z.Cells(rZelle.Row, iSpalte).Value = WkSh_Q.Cells(lZeile_Q, 6).Value
End If
End With
End If
Next lZeile_Q
Application.ScreenUpdating = True ' den Bildschirm-Update wieder zulassen
End Sub


Anzeige
AW: Werte mit VBA kopieren
14.02.2008 09:34:22
markus473
Danke so funktioniert es, jodoch gibt es folgendes Problem.
Da die zu kopierenden Gruppen nicht immer gleich sind, der Wert aber immer der ersten freien Spalte zugeordnet wird, führt das dazu, dass beim einfügen einer neuen Gruppe der Wert in der falschen Spalte steht.
Kann man das insoweit ändern, das die restlichen Werte dieser Spalte mit 0 (Zeile 5-32) gefüllt werden, auch wenn kein Wert für die "Nummer" vorhanden ist. So das die Werte für jede Operation in der gleichen Spalte stehen!
Danke Gruß Markus

AW: Werte mit VBA kopieren
14.02.2008 19:13:45
fcs
Hallo markus,
das erfordert dann im Makro etwas mehr "Vorarbeit". Es gibt dann allerdings ein Problem, wenn bei einem Kopiervorgang die gleiche Kombination von "Gruppe" und "Nummer" in mehren Zeilen vorkommt. Es ist dann immer nur der letzte Summenwert in den Blättern vorhanden.
Gruß
Franz

Public Sub Kopierenorg()
Dim WkSh_Q       As Worksheet  ' das Quell-Tabellenblatt - Statistik
Dim WkSh_Z       As Worksheet  ' das Ziel-Tabellenblatt - wird dynamisch festgelegt
Dim lZeile_Q     As Long       ' For/Next Schleifen-Index der Zeile im Quell-Blatt
Dim iSpalte      As Integer    ' For/Next Schleifen-Index der Spalten
Dim sSuchbegr    As String     ' der Suchbegriff - hier die Gruppe
Dim rZelle       As Range      ' die Zelle in der die Gruppe gefunden wurde / oder nicht
Dim arrBlattNr, iI As Integer
Dim arrSpalte() As Integer 'Feld für auszufüllende Spalte im Blatt
Application.ScreenUpdating = False   ' kein Bildschirm-Update während des Makro-Laufs
arrBlattNr = Array(810, 815, 820)
ReDim arrSpalte(LBound(arrBlattNr) To UBound(arrBlattNr))
For iI = LBound(arrBlattNr) To UBound(arrBlattNr)
Select Case arrBlattNr(iI) ' die Nummer als Case auswerten
Case 810                    ' ist es die Nummer für Tabellenblatt 810 ?
Set WkSh_Z = Worksheets("810")
Case 815                    ' ist es die Nummer für Tabellenblatt 815 ?
Set WkSh_Z = Worksheets("815")
Case 820                    ' ist es die Nummer für Tabellenblatt 820 ?
Set WkSh_Z = Worksheets("820")
End Select
For iSpalte = 3 To 8               ' die erste freie Spalte in Zeile im Blatt finden
If iSpalte = 8 Then
MsgBox "Es sind schon alle Spalten im Blatt " & WkSh_Z.Name _
& " ausgefüllt! Tabelle und Makro anpassen!"
Exit Sub
Else
If WkSh_Z.Cells(5, iSpalte) = "" Then ' ist die Zelle der ersten Gruppe leer ?
arrSpalte(iI) = iSpalte
With WkSh_Z
.Range(.Cells(5, iSpalte), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, _
iSpalte)).Value = 0
End With
Exit For                       ' und die For/Next Schleife verlassen
End If
End If
Next iSpalte                         ' die nächste Spalte heranziehen
Next iI
Set WkSh_Q = Worksheets("Statistik") ' das Quell-Tabellenblatt festlegen
For lZeile_Q = 2 To WkSh_Q.Cells(Rows.Count, 2).End(xlUp).Row
Set WkSh_Z = Nothing
sSuchbegr = WkSh_Q.Cells(lZeile_Q, 2).Value ' die Gruppe als Suchbegriff speichern
'Zieltabelle gemäß Nummer setzen
Select Case WkSh_Q.Cells(lZeile_Q, 5).Value ' die Nummer als Case auswerten
Case 810                    ' ist es die Nummer für Tabellenblatt 810 ?
Set WkSh_Z = Worksheets("810")
iSpalte = arrSpalte(LBound(arrSpalte))
Case 815                    ' ist es die Nummer für Tabellenblatt 815 ?
Set WkSh_Z = Worksheets("815")
iSpalte = arrSpalte(LBound(arrSpalte) + 1)
Case 820                    ' ist es die Nummer für Tabellenblatt 820 ?
Set WkSh_Z = Worksheets("820")
iSpalte = arrSpalte(LBound(arrSpalte) + 2)
End Select
If Not WkSh_Z Is Nothing Then
With WkSh_Z.Columns(2) ' im Blatt die Spalte 2 = B festlegen
'                 in der Spalte 2 = B nach der Gruppe suchen
Set rZelle = .Find(sSuchbegr, LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then ' wurde die Gruppe gefunden ?
'                    die Summe übertragen
If IsEmpty(WkSh_Q.Cells(lZeile_Q, 6)) Then
WkSh_Z.Cells(rZelle.Row, iSpalte).Value = 0
Else
WkSh_Z.Cells(rZelle.Row, iSpalte).Value = WkSh_Q.Cells(lZeile_Q, 6).Value
End If
End If
End With
End If
Next lZeile_Q
Application.ScreenUpdating = True ' den Bildschirm-Update wieder zulassen
End Sub


Anzeige
AW: Werte mit VBA kopieren
14.02.2008 19:30:42
Markus473
Danke Franz,
gleiche Gruppen und Nummer kommen bei mir nicht vor!
Glück gehabt, vielen Dank nochmal!
Gruß Markus

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige