Schleife in Array

Sub ZeitAAAWeichen() Dim i As Integer Dim x As Integer Dim IHvar As Variant Dim Mytag As String Dim Tbb As Integer For x = 2 To 21 'diese Schleife ins Array IHvar = Sheets(9).Cells(x, 11).Value For Tbb = 1 To 8 For i = 6 To 2001 If Sheets(Tbb).Cells(i, 8) = IHvar Then Mytag = Mytag & Sheets(Tbb).Cells(i, 4) & vbCr End If Next i Next Tbb Next x MsgBox Mytag End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ulf,
zwei Varianten:
Die erste Prozedur arbeitet mit Find, vermutlich um Einiges schneller.
Bei der anderen werden die Suchbegriffe in einen String geschrieben,
dann wird darauf InStr angewandt. Ist nicht unbeingt schneller als deine Variante.
Getestet sind beide noch nicht.

Option Explicit
Sub ZeitAAAWeichen3()
Dim i As Integer
Dim x As Integer
Dim IHvar As String
Dim Mytag As String
Dim Tbb As Integer
Dim rngGef As Range, lngErst As Long
For x = 2 To 21
IHvar = Sheets(9).Cells(x, 11).Value
For Tbb = 1 To 8
With Range(Worksheets(Tbb).Cells(6, 8), Worksheets(Tbb).Cells(2001, 8))
Set rngGef = .Find(What:=IHvar, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rngGef Is Nothing Then
lngErst = rngGef.Row
Do
Mytag = Mytag & Sheets(Tbb).Cells(rngGef.Row, 4) & vbCr
Set rngGef = .FindNext(rngGef)
Loop While Not rngGef Is Nothing And rngGef.Row > lngErst
End If
End With
Next Tbb
Next x
MsgBox Mytag
End Sub
Sub ZeitAAAWeichen2()
Dim i As Integer
Dim x As Integer
Dim IHvar As String
Dim Mytag As String
Dim Tbb As Integer
IHvar = "#"
For x = 2 To 21  ' Werte von Sheets(9) in einen String
IHvar = IHvar & Sheets(9).Cells(x, 11).Value & "#"
Next x
For Tbb = 1 To 8
For i = 6 To 2001
If InStr(IHvar, "#" & Sheets(Tbb).Cells(i, 8) & "#") > 0 Then
Mytag = Mytag & Sheets(Tbb).Cells(i, 4) & vbCr
End If
Next i
Next Tbb
MsgBox Mytag
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Sub ZeitAAAWeichen() Dim i As Integer Dim x As Integer Dim Tbb As Integer Dim IHvar As Variant Dim Mytag As String IHvar = Sheets(9).Range("K2:K21") For Tbb = 1 To 8 Dim myArray myArray = Sheets(Tbb).Range("D6:H2001") For x = 1 To UBound(IHvar, 1) For i = 1 To UBound(myArray, 1) If myArray(i, 5) = IHvar(x, 1) Then Mytag = Mytag & myArray(i, 1) & vbCr End If Next i Next x Next Tbb MsgBox Mytag End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread