VBA für die Suche string in einer Spalte und kopieren Sie ganze Zeilen abhängig von der Anwesenheit bestimmter string in die benachbarte Zelle

Ich bin völlig neu in VBA.
Ich habe excel-Datenblatt mit zahlen und strings. Ich will die Suche nach bestimmten Zeichenfolge sagen, 'CYP' in der Spalte I dann schauen Sie für eine Zelle der Zeile in Spalte C und kopieren Sie ganze Zeilen, die den string der Zelle C. ich will einfügen in Blatt 2 der gleichen Arbeitsmappe und Schleife Sie erneut zu suchen für die restlichen CYPs in der Spalte.

Würden Sie mir helfen, bitte?

Nach dem Vorschlag von pnuts, hier ist mein makro-code

Sub Macro1()
'
' Macro1 Macro
'

'
    Columns("I:I").Select
    Range("I729").Activate
    Selection.Find(What:="cyp", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveWindow.SmallScroll Down:=5
    Range("C749").Select
    Selection.Copy
    Columns("C:C").Select
    Range("C734").Activate
    Selection.Find(What:="EPT001TT0601C000151", After:=ActiveCell, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
        , MatchCase:=False, SearchFormat:=False).Activate
    Rows("746:750").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Paste
End Sub

In diesem code der CYP wurde in I749 -, Zell-C749 kopiert wurde, als string und die erste Zeile in Spalte C enthält die Zeichenfolge die durchsucht wurde, gefolgt durch kopieren der gesamten Zeile und 4 weitere folgten, dann einfügen in Tabelle2 der gleichen Arbeitsmappe.
Was ich wollte, war in der Schleife diese Aktion wieder und wieder, bis das Ende der Spalte I und wiederholen Sie die gleiche Aktion.

Danke!

  • THIS erhalten Sie begann
  • Dank Siddharth Rout. Ich habe versucht, aber konnte keine Lösung finden. Jede Hilfe, Jungs?
InformationsquelleAutor Prakshbabu | 2013-10-19
  1. 0

    Habe ich es geschafft das problem zu lösen mit der Hilfe von Trebor76 im Excelforum. Hier gebe ich die Lösung in dieser Weise ist es vielleicht hilfreich für einige Anfänger wie mich, die mit ähnlichen problem.

    Option Explicit
Sub Macro1()

    'Written and assisted by Trebor76

    'Copy an entire row from Sheet1 to Sheet2 for each unique matching item in Col. C if the text in Col. I contains the text 'CYP' (case sensitive)

    'http://www.excelforum.com/excel-programming-vba-macros/962511-vba-for-searching-string-in-a-column-and-copy-rows-depending-on-string-in-adjacent-cell.html

    Dim rngCell As Range
    Dim objMyUniqueArray As Object
    Dim lngMyArrayCounter As Long
    Dim lngMyRow As Long
    Dim varMyItem As Variant

    Application.ScreenUpdating = False

    Set objMyUniqueArray = CreateObject("Scripting.Dictionary")

    For Each rngCell In Sheets("Sheet1").Range("I1:I" & Sheets("Sheet1").Range("I" & Rows.Count).End(xlUp).Row)
        If InStr(rngCell, "CYP") > 0 Then
            If Not objMyUniqueArray.Exists(Trim(Cells(rngCell.Row, "C"))) Then
                lngMyArrayCounter = lngMyArrayCounter + 1
                objMyUniqueArray.Add (Trim(Cells(rngCell.Row, "C"))), lngMyArrayCounter
                varMyItem = Sheets("Sheet1").Cells(rngCell.Row, "C")
                For lngMyRow = 1 To Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
                    If Sheets("Sheet1").Cells(lngMyRow, "C") = varMyItem Then
                        Rows(lngMyRow).Copy Destination:=Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1)
                    End If
                Next lngMyRow
            End If
        End If
    Next rngCell

    Set objMyUniqueArray = Nothing

    Application.ScreenUpdating = True

    MsgBox "All applicable rows have been copied.", vbInformation

End Sub

    Prost!

    InformationsquelleAutor Prakshbabu
Schreibe einen Kommentar