Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Alle tabellenblätter nach zelleninhalt durchsuchen

Betrifft: Alle tabellenblätter nach zelleninhalt durchsuchen von: Spenski
Geschrieben am: 25.07.2014 21:34:56

Hallo

Im tabellenblatt "Daten" steht in A1 eine 9 stellige nummer.
Gibt es eine Möglichkeit in B1 sich anzeigen zu lassen wie oft der zelleninhalt A1 in der spalte c aller anderen tabellenblätter vorkommt?

Es kommen jede Woche 2 neue tabellenblätter dazu , und 2 werden gelöscht. Am besten ohne die Formel / Code jedesmal anzupassen.

Gruß
Christian

  

Betrifft: benutze COUNTIF mit VBA von: Matthias L
Geschrieben am: 25.07.2014 22:02:09

Hallo

oder Zählenwenn als Formel

Tabelle1

 AB
1123456789Anz. in Tabelle
2Tabelle23
3Tabelle38

Formeln der Tabelle
ZelleFormel
B2=ZÄHLENWENN(Tabelle2!C:C;A1)
B3=ZÄHLENWENN(Tabelle3!C:C;A1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Gruß Matthias


  

Betrifft: AW: Alle tabellenblätter nach zelleninhalt durchsuchen von: Matthias L
Geschrieben am: 25.07.2014 22:30:50

Hallo

Hier mal noch eine Variante mit Indirekt

Tabelle1

 AB
112345678916
2Tabelle23
3Tabelle38
4Tabelle4 
5Tabelle5 
6Tabelle6 
7Tabelle7 
8Tabelle85
9Tabelle9 

Formeln der Tabelle
ZelleFormel
B1=SUMME(B2:B1048576)
B2=WENN(ISTFEHLER(ZÄHLENWENN(INDIREKT(A2&"!C:C");$A$1));"";ZÄHLENWENN(INDIREKT(A2&"!C:C");$A$1))
B3=WENN(ISTFEHLER(ZÄHLENWENN(INDIREKT(A3&"!C:C");$A$1));"";ZÄHLENWENN(INDIREKT(A3&"!C:C");$A$1))
B4=WENN(ISTFEHLER(ZÄHLENWENN(INDIREKT(A4&"!C:C");$A$1));"";ZÄHLENWENN(INDIREKT(A4&"!C:C");$A$1))
B5=WENN(ISTFEHLER(ZÄHLENWENN(INDIREKT(A5&"!C:C");$A$1));"";ZÄHLENWENN(INDIREKT(A5&"!C:C");$A$1))
B6=WENN(ISTFEHLER(ZÄHLENWENN(INDIREKT(A6&"!C:C");$A$1));"";ZÄHLENWENN(INDIREKT(A6&"!C:C");$A$1))
B7=WENN(ISTFEHLER(ZÄHLENWENN(INDIREKT(A7&"!C:C");$A$1));"";ZÄHLENWENN(INDIREKT(A7&"!C:C");$A$1))
B8=WENN(ISTFEHLER(ZÄHLENWENN(INDIREKT(A8&"!C:C");$A$1));"";ZÄHLENWENN(INDIREKT(A8&"!C:C");$A$1))
B9=WENN(ISTFEHLER(ZÄHLENWENN(INDIREKT(A9&"!C:C");$A$1));"";ZÄHLENWENN(INDIREKT(A9&"!C:C");$A$1))


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Gruß Matthias


  

Betrifft: AW: Alle tabellenblätter nach zelleninhalt durchsuchen von: Mullit
Geschrieben am: 25.07.2014 22:31:20

Hallo,

für eine Zelle ginge auch so etwas:

Option Explicit

Public Sub test()
Dim strFirstAddress As String
Dim lngCount As Long
Dim objRange As Range
Dim wksSheet As Worksheet
For Each wksSheet In Worksheets
   With wksSheet
       If .CodeName <> ActiveSheet.Name Then
         With .Columns(3)
             Set objRange = .Find(What:=ActiveSheet.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
             If Not objRange Is Nothing Then
               strFirstAddress = objRange.Address
               Do
                 lngCount = lngCount + 1
                 Set objRange = .FindNext(After:=objRange)
               Loop While Not objRange Is Nothing And objRange.Address <> strFirstAddress
             End If
         End With
       End If
   End With
Next
ActiveSheet.Cells(1, 2) = lngCount
Set objRange = Nothing
End Sub



VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 12

Gruß,


  

Betrifft: AW: Alle tabellenblätter nach zelleninhalt durchsuchen von: Mullit
Geschrieben am: 25.07.2014 23:29:48

Hallo,

uups natürlich ist das hier besser:

'...
If .CodeName <> ActiveSheet.CodeName Then
'...

Gruß,


  

Betrifft: Ja, gut, aber ... von: Matthias L
Geschrieben am: 26.07.2014 00:38:32

Hallo

Nun müsstest Du nur noch sicherstellen, das Du Dich auch in der entsprechenden Tabelle befindest.
Sonst kommt nämlich ein anderes/falsches Ergebnis raus.

Gruß Matthias


  

Betrifft: AW: Ja, gut, aber ... von: Mullit
Geschrieben am: 26.07.2014 01:11:41

Hallo,

null problemo und dann gleich noch eine Countif-Variante:

Option Explicit

Public Sub test()
Dim dblReturn As Double
Dim wksSheet As Worksheet
For Each wksSheet In Worksheets
   With wksSheet
       If .CodeName <> Worksheets("Daten").CodeName Then _
         dblReturn = dblReturn + WorksheetFunction.CountIf(.Columns(3), _
             Worksheets("Daten").Cells(1, 1))
   End With
Next
Worksheets("Daten").Cells(1, 2) = dblReturn
End Sub



VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 12

Gruß,


  

Betrifft: danke für die Zahlreichen antworten von: Spenski
Geschrieben am: 26.07.2014 03:00:07

erstmal danke an alle die sich die mühe gemacht haben und sich mit meinem problem beschäftigt haben.

am besten hat mir die VBA version von Mullit zugesagt , die anderen Möglichkeiten habe ich mir aber auch archiviert , braucht man bestimmt auch irgendwann.
ich ärgere mich gerade bisschen über mich selbst da ich die frage / mein problem nicht genau genug beschrieben habe.
Es stehen in Spalte A mehrere Werte , nicht nur in A1. ohne VBA würd ichs hinbekommen, aber die vba weiss ich nicht was ich änderen muss damit er alle abarbeitet.
wäre das mit dem code möglich?? tut mir leid für die mehrarbeit

Option Explicit

Public Sub test()
Dim dblReturn As Double
Dim wksSheet As Worksheet
For Each wksSheet In Worksheets
   With wksSheet
       If .CodeName <> Worksheets("Daten").CodeName Then _
         dblReturn = dblReturn + WorksheetFunction.CountIf(.Columns(3), _
             Worksheets("Daten").Cells(1, 1))
            
             
             
   End With
Next
Worksheets("Daten").Cells(1, 2) = dblReturn
End Sub

danke allen und ein erholsammes wochenende


  

Betrifft: AW: danke für die Zahlreichen antworten von: Mullit
Geschrieben am: 26.07.2014 06:26:02

Hallo,

null problemo, das könnte z.B. so gehen:

Option Explicit

Public Sub test()
Dim lngIndex As Long
Dim dblReturn As Double
Dim wksSheet As Worksheet
With Worksheets("Daten")
    For lngIndex = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
       dblReturn = 0
       For Each wksSheet In Worksheets
          If wksSheet.CodeName <> .CodeName Then _
            dblReturn = dblReturn + WorksheetFunction.CountIf(wksSheet.Columns(3), _
              .Cells(lngIndex, 1))
       Next
       .Cells(lngIndex, 2) = dblReturn
    Next
End With
End Sub



VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 14

Gruß,


  

Betrifft: AW: danke für die Zahlreichen antworten von: Spenski
Geschrieben am: 26.07.2014 08:02:59

funktioniert einwandfrei , ich danke dir :D

ist jetzt nur interessehalber um zu verstehen wie dieser code arbeitet.
liesste der code blatt für blatt , zeile für zeile nacheinander aus oder alles auf einmal?

wenn ja würde so was gehen?? : https://www.herber.de/bbs/user/91730.xlsm

Das soll keine aufforderung zum nachbau sein :D mich interessiert es nur , es sei den es wäre kein grosser Aufwand :D :D

Danke
Christian


  

Betrifft: AW: danke für die Zahlreichen antworten von: Spenski
Geschrieben am: 26.07.2014 13:53:25

siehe letzten post.

anfangsthema ist zu 100% erfüllt. war mir nicht sicher ob neuer thread oder hier weiter machen.


  

Betrifft: AW: danke für die Zahlreichen antworten von: Mullit
Geschrieben am: 27.07.2014 00:33:57

Hallo,

richtig, zunächst die Zeile des Quellblattes und dann werden nacheinander die TabBlätter auf Übereinstimmung geprüft.

Was den Nachschlag angeht, da könnte man z.B. zur Find-Methode zurückwechseln:

Option Explicit

Public Sub test()
Const START_ROW As Long = 2
Dim blnFirstRun As Boolean
Dim strFirstAddress As String
Dim ialngCount As Long, ialngIndex As Long
Dim lngIncr As Long
Dim avntArray() As Variant
Dim objRange As Range
Dim wksSheet As Worksheet
With Worksheets("Daten")
    For ialngIndex = START_ROW To .Cells(.Rows.Count, 1).End(xlUp).Row
       ialngCount = 0
       lngIncr = 0
       For Each wksSheet In Worksheets
          If wksSheet.CodeName <> .Name Then
            Set objRange = wksSheet.Columns(3).Find(What:=.Cells(ialngIndex, 1), _
               LookIn:=xlValues, LookAt:=xlWhole)
            If Not objRange Is Nothing Then
               strFirstAddress = objRange.Address
               Do
                  ialngCount = ialngCount + 1
                   If blnFirstRun Then
                     If Ubound(avntArray, 2) < ialngCount + lngIncr Then _
                       Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                         ialngCount * 2) As Variant
                   Else
                      Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                        ialngCount * 2) As Variant
                   End If
                   avntArray(ialngIndex - START_ROW, 0) = ialngCount
                   avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, -2)
                   lngIncr = lngIncr + 1
                   avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, -1)
                   Set objRange = wksSheet.Columns(3).FindNext(After:=objRange)
                Loop While Not objRange Is Nothing And objRange.Address <> strFirstAddress
            End If
          End If
       Next
       If Not blnFirstRun Then blnFirstRun = Not blnFirstRun
    Next
    If 2 + Ubound(avntArray, 2) < .UsedRange.Columns.Count - 1 Then _
       Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
         .UsedRange.Columns.Count - 1) As Variant
    .Range(.Cells(START_ROW, 2), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
      2 + Ubound(avntArray, 2))) = avntArray
End With
Set objRange = Nothing
End Sub



VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 12

Bin jetzt davon ausgegangen, daß die Zahlen auch häufiger in einer Tabellle vorkommen können, sonst wäre u.U. auch noch eine (einfachere) Matchvariante möglich...

Gruß,


  

Betrifft: AW: danke für die Zahlreichen antworten von: Spenski
Geschrieben am: 27.07.2014 06:42:44

guten morgen mullit
ich bin immer wieder begeistert über das können und wissen mancher leute.

der code funktioniert soweit ganz gut.

was mit aber aufgefallen ist , das er das erste tabellenblatt das er findet von oben nach unten ausliesst , und ale folgenden von unten nach oben. kann das sein??? das würfelt mir bisschen mein ergebniss durcheinander, da wie du schon vermutet hast mehrere ergebnisse in einem tabellenblatt vorkommen können , und einer der auszulesenen werte ein datum ist.

geht das auch immer von oben nach unten??

falls es eine rolle spielt , jedes blatt brauch nur bis zeile 800 ausgelsen werden , danach kommen keine daten mehr.


wünsch dir nen tollen sonntag

gruss


  

Betrifft: probleme/frage zum code von: Spenski
Geschrieben am: 27.07.2014 15:18:33

Hallo Mullit

ich hab mich heute sehr lange mit dem code beschäftigt um zu schauen wie man ihn auch mal erweitern kann.
teilweise hab ichs rausbekommen aber es stellten sich mir auch viele fragen^^

hab mal ein paar scenarien durchgespielt.

1. wie im vorpost schon erwähnt müsste der code die tabellenblätter von oben nach unten durchlesen (nach zeile 800 kommen keine eingaben mehr)

2. ist im Blatt "Daten" Spalte A eine Zeile zwischen den eingaben leer sicht er nach allen freien zellen in Spalte C . gibts da ne möglichkeit die zu überspringen ? ansonsten müsste ich mal schauen ob ich n code zusammenbekomme der nach deinem code alle zeilen löscht wo in Spalte A leer ist.

3. die code durchsucht ja alle Tabellenblätter Spalte C. sogar das Tabellenblatt Daten. gibts eine möglichkeit dem code zu saqen welche Tabellenblätter er NICHT durchsuchen soll?

4. Im tabellenblatt "Daten" fängt er ja an in B2 die Daten niederzuschreiben die er findet. wie müsste man den code ändern das er Spalte B frei lässt und in C anfängt?



ich weiss das sind viele fragen und das ist für mich auch nicht selbstverständlich das sich jemand um meine probleme kümmert.
wenns zuviel wird ists nicht schlimm ich bin dir auch so schon sehr dankbar. eigentlich allen hier im forum :D

gruss
christian


  

Betrifft: AW: probleme/frage zum code von: Mullit
Geschrieben am: 27.07.2014 21:23:42

Hallo Christian,

kein Problem, ich mach mich schon bemerkbar (oder gerade nicht...), wenn ich die Segel streichen muß...

zu 1)
Hierzu den After-Parameter in der Findmethode ergänzen.

zu 2)
Über eine If-Anweisung den Quellbereich auf Leerzellen abfragen.

zu 3)
Uhhh, da hab' ich den Fehler oben berichtigt und bau' ihn gleich wieder ein:
Es muß natürlich heißen:

If wksSheet.CodeName <> .CodeName Then

Für weitere Selektierungen kannst Du z.B. einfach die If-Anweisungen oder Select Case Anw. ergänzen...

zu 4)
START_COLUMN legt jetzt die Anfangsspalte fest.

Weiß der Teufel, warum ich da ein boolsche Variable eingefügt habe, die
kann raus...
Option Explicit

Public Sub test()
Const START_ROW As Long = 2
Const START_COLUMN As Long = 3
Dim strFirstAddress As String
Dim ialngCount As Long, ialngIndex As Long
Dim lngIncr As Long
Dim avntArray() As Variant
Dim objRange As Range
Dim wksSheet As Worksheet
With Worksheets("Daten")
    For ialngIndex = START_ROW To .Cells(.Rows.Count, 1).End(xlUp).Row
       If .Cells(ialngIndex, 1) <> vbNullString Then
         ialngCount = 0
         lngIncr = 0
         For Each wksSheet In Worksheets
            If wksSheet.CodeName <> .CodeName Then
              Set objRange = wksSheet.Columns(3).Find(What:=.Cells(ialngIndex, 1), _
                After:=wksSheet.Cells(wksSheet.Cells(wksSheet.Rows.Count, 3).End(xlUp).Row, 3), _
                LookIn:=xlValues, LookAt:=xlWhole)
              If Not objRange Is Nothing Then
                 strFirstAddress = objRange.Address
                 Do
                    ialngCount = ialngCount + 1
                    If ialngIndex > START_ROW Then
                      If Ubound(avntArray, 2) < ialngCount + lngIncr Then _
                        Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                          ialngCount * 2) As Variant
                    Else
                      Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                        ialngCount * 2) As Variant
                    End If
                    avntArray(ialngIndex - START_ROW, 0) = ialngCount
                    avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, -2)
                    lngIncr = lngIncr + 1
                    avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, -1)
                    Set objRange = wksSheet.Columns(3).FindNext(After:=objRange)
                 Loop While Not objRange Is Nothing And objRange.Address <> strFirstAddress
              End If
            End If
         Next
       End If
    Next
    If 2 + Ubound(avntArray, 2) < .UsedRange.Columns.Count - 1 Then _
       Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
         .UsedRange.Columns.Count - 1) As Variant
    .Range(.Cells(START_ROW, START_COLUMN), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
      START_COLUMN + Ubound(avntArray, 2))) = avntArray
End With
Set objRange = Nothing
End Sub



VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 14

Die UsedRange-Eigenschaft kann unter einigen Bedingungen ungenau werden, sollten da Probleme auftauchen, hier mal schauen...

Vielleicht läuft's jetzt besser...

Gruß, Mullit


  

Betrifft: AW: probleme/frage zum code von: Spenski
Geschrieben am: 27.07.2014 21:48:04

der hammer...du glaubst gar nicht wie glücklich du mich gerade gemacht hast.

danke

kleine frage noch zu Pkt3

zu 3)
Uhhh, da hab' ich den Fehler oben berichtigt und bau' ihn gleich wieder ein:
Es muß natürlich heißen:

If wksSheet.CodeName <> .CodeName Then

muss ich da den fetten text duch den tabellenblattnamen ersetzen der nicht ausgelesen werden soll?

gruss
christian


  

Betrifft: AW: probleme/frage zum code von: Mullit
Geschrieben am: 27.07.2014 22:27:56

Hallo Christian,

prima;

.CodeName stellt den Objektnamen Deines Quellblattes "Daten" dar, wenn Du das weiterhin nicht durchsuchen willst, dann nicht .CodeName ersetzen, sondern z.B. die If- Anw. über den And-Operator mit den weiteren Objektnamen der Tabellen, die nicht durchsucht werden sollen, ergänzen. Bspw:

If wksSheet.CodeName <> .CodeName And wksSheet.CodeName <> Worksheets("NeuDaten").CodeName Then

Gruß Mullit,


  

Betrifft: AW: probleme/frage zum code von: Spenski
Geschrieben am: 27.07.2014 22:48:45

Okay dank dir :)


  

Betrifft: AW: probleme/frage zum code von: Mullit
Geschrieben am: 28.07.2014 19:58:05

Hallo Christian,

der Löscher machte noch ewas Ärger, sollte so bessser sein:

'...
If 1 + UBound(avntArray, 2) < .UsedRange.Columns.Count Then _
      ReDim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
         .UsedRange.Columns.Count) As Variant
    .Range(.Cells(START_ROW, START_COLUMN), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
      START_COLUMN + UBound(avntArray, 2))) = avntArray
End With
Set objRange = Nothing
End Sub

Gruß Mullit,


  

Betrifft: AW: probleme/frage zum code von: Spenski
Geschrieben am: 30.07.2014 13:04:18

Hi Mullit , hab zufällig gesehen das du noch was geschrieben hast.


In wie fern machte er ärger?? Er buggte wenn es keinen Wert gibt nach dem er suchen soll....meinst du das damit?

Gruss


  

Betrifft: AW: probleme/frage zum code von: Mullit
Geschrieben am: 30.07.2014 21:43:34

Hallo,

die Zeilen sind zum Löschen der 'Überhangdaten', wenn Du die Tabellenanzahl verringerst, oder START_COLUMN verkleinerst, da blieben vorher noch Reste stehen, zudem wurden keine Zeilen gelöscht; hab' ich noch miteingebaut...

Die boolsche Variable war doch nicht so schlecht: Leerzeilen können jetzt auch am Anfang stehen...

Bugging-Problem: uhh ja; den Fall hatte ich noch nicht abgefangen:

Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
    ByRef pArray() As Any) As Long

Public Sub test()
Const START_ROW As Long = 2
Const START_COLUMN As Long = 3
Dim blnInit As Boolean
Dim strFirstAddress As String
Dim ialngCount As Long, ialngIndex As Long
Dim lngIncr As Long
Dim avntArray() As Variant
Dim objRange As Range
Dim wksSheet As Worksheet
With Worksheets("Daten")
    For ialngIndex = START_ROW To .Cells(.Rows.Count, 1).End(xlUp).Row
       If .Cells(ialngIndex, 1) <> vbNullString Then
         ialngCount = 0
         lngIncr = 0
         For Each wksSheet In Worksheets
            If wksSheet.CodeName <> .CodeName Then
              Set objRange = wksSheet.Columns(3).Find(What:=.Cells(ialngIndex, 1), _
                After:=wksSheet.Cells(wksSheet.Cells(wksSheet.Rows.Count, 3).End(xlUp).Row, 3), _
                LookIn:=xlValues, LookAt:=xlWhole)
              If Not objRange Is Nothing Then
                 strFirstAddress = objRange.Address
                 Do
                    ialngCount = ialngCount + 1
                    If blnInit Then
                      If Ubound(avntArray, 2) < ialngCount + lngIncr Then _
                        Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                          ialngCount * 2) As Variant
                    Else
                      Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                        ialngCount * 2) As Variant
                    End If
                    avntArray(ialngIndex - START_ROW, 0) = ialngCount
                    avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, -2)
                    lngIncr = lngIncr + 1
                    avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, -1)
                    Set objRange = wksSheet.Columns(3).FindNext(After:=objRange)
                 Loop While Not objRange Is Nothing And objRange.Address <> strFirstAddress
              End If
            End If
         Next
         If Not blnInit Then blnInit = Not blnInit
       End If
    Next
    If .Cells(.Rows.Count, 1).End(xlUp).Row < .UsedRange.Rows.Count + 1 Then _
      .Range(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, START_COLUMN), _
         .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).ClearContents
    If CBool(SafeArrayGetDim(avntArray)) Then
      If 1 + Ubound(avntArray, 2) < .UsedRange.Columns.Count Then _
        Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
           .UsedRange.Columns.Count) As Variant
      .Range(.Cells(START_ROW, START_COLUMN), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
        START_COLUMN + Ubound(avntArray, 2))) = avntArray
    Else
      MsgBox "Keine Daten zur Überprüfung vorhanden!", vbExclamation
    End If
End With
Set objRange = Nothing
End Sub



VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel


Code erstellt und getestet in Office 12

Gruß, Mullit


  

Betrifft: danke von: Spenski
Geschrieben am: 31.07.2014 07:40:37

super werds gleich auf der arbeit mal ausprobieren...feedback folgt


gruss


  

Betrifft: AW: danke von: Spenski
Geschrieben am: 31.07.2014 18:41:43

läuft bis jetzt super...noch mal danke , auch von meinen kollegen^^


  

Betrifft: Top:: owT. von: Mullit
Geschrieben am: 01.08.2014 01:12:35




 

Beiträge aus den Excel-Beispielen zum Thema "Alle tabellenblätter nach zelleninhalt durchsuchen"

Benennen von Tabellenblättern mit Monatsnamen
Suchbegriff über mehrere Tabellenblätter suchen.
Tabellenblätter benennen
Tabellenblätter in umgekehrter Reihenfolge drucken
Druck aus mehreren Tabellenblättern auf eine Druckseite
Letztes Speicherdatum in die Fußzeile aller Tabellenblätter
Ausgewählte Tabellenblätter als eigene Arbeitsmappen speichern
Den selben Bereichsnamen in mehreren Tabellenblättern
Prüfung, welche Tabellenblätter aus einer Liste vorhanden sind
SUMMEWENN-Funktion über mehrere Tabellenblätter
Anlegen von Tabellenblättern gem. Namensliste
Tabellenblätter für Kalenderwochen anlegen und ein/ausblenden
Namen der selektierten Tabellenblätter auslesen
UserForm-TextBox-Einträge auf Tabellenblätter verteilen
Tabellenblätter kopieren, wenn Email-Adresse vorhanden
Textdatei nach Begriff durchsuchen und Fundzeile importieren
Zweidimensionale Matrix mit der SVERWEIS-Funktion durchsuchen
Tabelle nach ComboBox-Auswahl durchsuchen
Zeile 1 nach Wert der aktiven Zelle durchsuchen