Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1396to1400
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
Inhaltsverzeichnis

Alle Zellen Durchsuchen dann Midfunction

Alle Zellen Durchsuchen dann Midfunction
15.12.2014 12:19:05
Martha
Hallo liebes Forum,
Heute habe ich eine Frage zur Mid Funktion. Ich möchte zuerst alle Zeilen in Tabelle1 nach dem Wert "*In Progress*" durchsuchen. Enthalten die Zellen diesen Wert, so sollen sie an die exakt selbe Stelle in Tabelle2 kopiert werden und mit der Mid-Funktion sollen nur noch Zeichen 12 bis 19 in Tabelle 2 stehen bleiben. Die Zellen die in Tabelle1 nicht den Wert enthalten, sollen als leere Zelle kopiert werden.
Die Midfunction bekomme ich hin, habe allerdings Probleme, eine Schleife für alle Zellen zu erstellen, bisher funktioniert es nur Zeile oder Spalte...
Liebe Grüße und danke

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Alle Zellen Durchsuchen dann Midfunction
15.12.2014 12:38:00
yummi
Hallo Martha,
sub suche
dim llastz as long
dim ilasts as integer
dim i as long
dim j as integer
llastz = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ilasts = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
for i = 1 to llast
for j = 1 to ilasts
if Instr(1,ActiveSheet.Cells(i,j).value, "In Progress", vbTextCompare) 0 then
Sheets(2).cells(i,j).value = Mid(12, Cells(i,j).value, 7)
end if
next j
next i
So sollte es gehen, ist ungetestet
Gruß
yummi

eine Variante zum testen
15.12.2014 12:40:03
Tino
Hallo,
kannst mal so versuchen.
Sub Makro1()
Dim rngValues As Range, sTabName$, rngTmp As Range
With Tabelle1
'Bereich
Set rngValues = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
If rngValues.Rows(1).Row > 2 Then Exit Sub 'keine Daten
sTabName = "'" & .Name & "'!"
End With
With Tabelle2
Set rngTmp = .Range(rngValues.Address)
End With
rngTmp.FormulaR1C1 = _
"=MID(IF(COUNTIF(" & sTabName & "RC" & rngValues.Column & ",""*In Progress*"")" & _
"," & sTabName & "RC" & rngValues.Column & ",""""),12,8)"
rngTmp.Value = rngTmp.Value
End Sub
Gruß Tino

Anzeige
AW: eine Variante zum testen
15.12.2014 13:23:11
Martha
Hey, dann zeigt der Debugger mir einen Fehler bei
Set rngValues = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
Liebe Grüße

AW: eine Variante zum testen
15.12.2014 13:31:09
Martha
Ok, habe auf A1 gestellt und jetzt läuft das Makro erstmal ohne Fehler durch. Allerdings ohne _ Erfolg. Nichts wird kopiert. Aber vielleicht liegt das an dem

""*In Progress*""

Im Grunde steht in der Zelle mehr als nur dieser Begriff. Das heißt die Abfrage, wie ich sie kenne, müsste so aussehen:
I cell.value like "*In Progress*" then ...
kann ich das so in deinen Code umschreiben?
Danke

Anzeige
AW: eine Variante zum testen
15.12.2014 13:31:44
Martha
Ok, habe auf A1 gestellt und jetzt läuft das Makro erstmal ohne Fehler durch. Allerdings ohne Erfolg. Nichts wird kopiert. Aber vielleicht liegt das an dem
""*In Progress*""

Im Grunde steht in der Zelle mehr als nur dieser Begriff. Das heißt die Abfrage, wie ich sie kenne, müsste so aussehen:
If cell.value like "*In Progress*" then ...
kann ich das so in deinen Code umschreiben?
Danke

AW: eine Variante zum testen
15.12.2014 13:33:45
Martha
Ok, habe auf A1 gestellt und jetzt läuft das Makro erstmal ohne Fehler durch. Allerdings ohne Erfolg. Nichts wird kopiert. Aber vielleicht liegt das an dem
""*In Progress*""

Im Grunde steht in der Zelle mehr als nur dieser Begriff. Das heißt die Abfrage, wie ich sie kenne, müsste so aussehen:
If cell.value like "*In Progress*" then ...
kann ich das so in deinen Code umschreiben?
Danke

Anzeige
AW: eine Variante zum testen
15.12.2014 13:35:46
Martha
Ok, habe auf A1 gestellt und jetzt läuft das Makro erstmal ohne Fehler durch. Allerdings ohne Erfolg. Nichts wird kopiert. Aber vielleicht liegt das an dem
""*In Progress*""

Im Grunde steht in der Zelle mehr als nur dieser Begriff. Das heißt die Abfrage, wie ich sie kenne, müsste so aussehen:
If cell.value like "*In Progress*" then ...
kann ich das so in deinen Code umschreiben?
Danke

AW: hier mein Beispiel...
15.12.2014 14:13:33
Martha
Hey, ja dein File funktioniert, allerdings auch nur für das Kopieren von Spalte A, wenn in Spalte B auch das Kriterium erfüllt ist, dann sollen die entsprechenden Zeichen auch in Spalte B eingetragen werden.
Danke

AW: hier mein Beispiel...
15.12.2014 16:53:55
Tino
Hallo,
hier für alle Spalten im Benutzen Bereich.
Evtl. bei Set rngValues = .UsedRange den Bereich anpassen
Sub Makro1()
Dim rngValues As Range, sTabName$, rngTmp As Range
With Tabelle1
'Bereich
Set rngValues = .UsedRange
If rngValues.Rows(1).Row > 2 Then Exit Sub 'keine Daten
sTabName = "'" & .Name & "'!"
End With
With Tabelle2
For Each rngValues In rngValues.Columns
Set rngTmp = .Range(rngValues.Address)
rngTmp.FormulaR1C1 = _
"=MID(IF(COUNTIF(" & sTabName & "RC" & _
rngValues.Column & ",""*In Progress*"")" & "," & _
sTabName & "RC" & rngValues.Column & ",""""),12,8)"
rngTmp.Value = rngTmp.Value
Next rngValues
End With
End Sub

Gruß Tino

Anzeige
AW: hier für Spalte A:B + Korrektur
16.12.2014 10:44:01
Martha
Hallo Tino,
also ich habe jetzt beide ausprobiert, die Datei, die auch Spalte B kopieren soll, kopiert bei mir auch nur Spalte A. Es tut mir leid, kann es sein, dass durch

Set rngValues = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))

zwar der richtige Bereich kopiert wird, es aber keinen definierten Zielbereich für die Spalte B ff gibt?
Liebe Grüße :)

Anzeige
AW: hier für Spalte A:B + Korrektur
16.12.2014 12:21:21
Tino
Hallo,
lade mal ein Beispiel von Dir hoch, dann versuch ich es einzubauen.
Gruß Tino

AW: hier für Spalte A:B + Korrektur
16.12.2014 13:09:01
Martha
Im Grunde komme ich auch nicht weiter, wenn du in deiner Datei die Spalte A in Spalte B händig kopierst und dann auf Start klickst, kopiert das Makro dir auch alle Zellen mit Inhalt "*In progress*" in Tabellenblatt2 Spalte B?
Ich dachte an eine Schleife, die nach Durchlaufen von Spalte A genau das Selbe, wie es auch in deiner Datei mit Spalte A geschieht, mit allen Spalten macht, in denen noch Inhalt steht. Ich habe versucht den Bereich besser zu definieren, allerdings reicht es nicht als .Range(A:J) anzugeben, da ich die Daten vorher importiere und deshalb auch in Spalte K etc. noch Inhalt stehen könnte. .UsedRange funktioniert auch nicht. ...Oh Gott ich stell mich vielleicht zu doof an, tut mir leid....
Ich bin dir super dankbar, dass du mir so gut hilfst :D
Liebe Grüße

Anzeige
AW: letzter Versuch...
16.12.2014 13:34:13
Martha
Du bist ein Held!
Danke, so ist es genau das was ich gebraucht habe!!!
Perfekt, mein Tag ist gerettet :D
Schönen Tag dir :)

AW: eine Variante zum testen
15.12.2014 13:24:07
Martha
Hey, dann zeigt der Debugger mir einen Fehler bei
Set rngValues = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
Liebe Grüße

AW: eine Variante zum testen
15.12.2014 13:59:20
Martha
Also beide Varianten laufen bei mir nicht, entschuldigt für die vielen Kommentare zuvor, mein Internet spinnt hier und schickt das anscheinend immer doppelt.
Für das Durchsuchen von Spalte A funktioniert folgender Code:

Private Sub Worksheet_Activate()
Dim i, k, LastRow
'Find last row
LastRow = Sheets("Read txt").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Analyse TKT").Range("A2:I500").ClearContents
For i = 4 To LastRow
If Sheets("Read txt").Cells(i, "A").Value Like "*to 'In Progress'*" Then
Sheets("Read txt").Cells(i - 1, "A").Copy Destination:=Sheets("Analyse TKT").Range("A" & Rows. _
Count).End(xlUp).Offset(1)
End If
Next i
For k = 4 To LastRow
If Sheets("Read txt").Cells(k, "A").Value Like "*from 'In Progress'*" Then
Sheets("Read txt").Cells(k - 1, "A").Copy Destination:=Sheets("Analyse TKT").Range("B" & Rows. _
Count).End(xlUp).Offset(1)
End If
Next k
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige