suche in allen tabellen und übertrage

hallo forum,
es befinden sich 32 tabellen in der zu bearbeitende datei.
tabelle 1-31 sind alle gleich formatiert.
tabelle 32 soll ein "summary" darstellen.
in tabelle summary stehen (spalte d15:d70) drei stringzeichen (zb CGN oder MUC etc.).
der Makro soll nun das Zeichen zb. CGN in tabelle 1-31 spalte B10:b60 (immer gleich) nach CGN suchen.
wenn gefunden, dann soll er diese gefundene anzahl zaehlen und in die tabelle summary F15 eintragen (zb "15" gefunden)
anschliessend soll es in tabelle 1-31 spalte p15:p70 ueberpruefen, ob die zelle leer ist oder nicht und die anzahl der nicht leeren zellen in tabelle summary zelle i15 eintragen.
wenn suche nach d15 (hier cgn) beendet ist, soll es weiter suchen mit d16.
diese schleife soll bis d70 laufen.
dank und gruss
mehmet

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Mehmet,
vielleicht ist das beigefügte Makro das, was du suchst.
Du musst "Tabelle3" noch gegen den Namen deines Summary-Blattes auswechseln.

Public Sub Zaehlen()
Dim WkSh_S   As Worksheet
Dim WkSh_X   As Worksheet
Dim iBlatt   As Integer
Dim lZeile   As Long
   Set WkSh_S = Worksheets("Tabelle3") ' den Blattnamen anpassen !!!
   For lZeile = 15 To 70
      For iBlatt = 1 To Sheets.Count
         If Sheets(iBlatt).Name <> "Tabelle3" Then ' den Blattnamen anpassen !!!
            Set WkSh_X = Worksheets(Sheets(iBlatt).Name)
            WkSh_S.Cells(lZeile, 6).Value = WkSh_S.Cells(lZeile, 6).Value + _
               Application.WorksheetFunction.CountIf(WkSh_X.Range("B10:B60"), _
               WkSh_S.Range("D" & lZeile).Value)
         End If
         If WkSh_X.Range("P" & lZeile).Value <> "" Then
            WkSh_S.Range("I" & lZeile).Value = 1
         End If
      Next iBlatt
   Next lZeile
End Sub

Code eingefügt mit Syntaxhighlighter 4.4

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.

Sub Zaehlen() Dim WkSh_S As Worksheet Dim WkSh_X As Worksheet Dim iBlatt As Integer Dim lZeile As Long Set WkSh_S = Worksheets("Summary") For lZeile = 15 To 70 For iBlatt = 1 To Sheets.Count If Sheets(iBlatt).Name <> "Summary" Then Set WkSh_X = Worksheets(Sheets(iBlatt).Name) WkSh_S.Cells(lZeile, 6).Value = WkSh_S.Cells(lZeile, 6).Value + _ Application.WorksheetFunction.CountIf(WkSh_X.Range("B10:B60"), _ WkSh_S.Range("D" & lZeile).Value) If WkSh_X.Range("P" & lZeile).Value <> "" Then WkSh_S.Range("I" & lZeile).Value = WkSh_S.Range("I" & lZeile).Value + 1 End If End If Next iBlatt Next lZeile End Sub

Beliebteste Forumthreads (12 Monate)

suche in allen tabellen und übertrage

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

suche in allen tabellen und übertrage

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread