VBA Script umbauen - replace | HERBERS Excel Forum

Sub SuchenErsetzen2() Dim arName3 As Variant Dim arName4 As Variant Dim ii As Long Dim lngSpalte2 As Long With Sheets("Do-Not-Edit") arName3 = .Range("F2:F" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value arName4 = .Range("H2:H" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value End With On Error Resume Next lngSpalte2 = Columns(20).Column On Error GoTo Ende With Sheets("NSC") If lngSpalte2 > 0 Then For ii = LBound(arName3) To UBound(arName3) .Columns(lngSpalte2).Replace arName3(ii, 1), arName4(ii, 1), xlWhole Next End If End With Exit Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ooooooops,
die leeren Zellen ausschließen habe ich vergessen.

Option Explicit

Public Sub SuchenErsetzen2()

    Dim avntName3 As Variant
    Dim avntName4 As Variant
    Dim avntValues As Variant
    Dim ialngIndex As Long
    Dim strFirsAddress As String
    Dim objCell As Range
    Dim objDictionary As Object

    On Error GoTo Ende

    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

    With Worksheets("Do-Not-Edit")
        avntName3 = .Range("F2:F" & CStr(.Cells(.Rows.Count, 1).End(xlUp).Row)).Value
        avntName4 = .Range("H2:H" & CStr(.Cells(.Rows.Count, 1).End(xlUp).Row)).Value
    End With

    With Worksheets("NSC")
        With .Range(.Cells(1, 20), .Cells(.Rows.Count, 20).End(xlUp))
            For ialngIndex = LBound(avntName3) To UBound(avntName3)
                objDictionary.Item(Key:=avntName3(ialngIndex, 1)) = vbNullString
                Set objCell = .Find(What:=avntName3(ialngIndex, 1), _
                    LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                If Not objCell Is Nothing Then
                    strFirsAddress = objCell.Address
                    Do
                        objCell.Offset(0, 27).Value = avntName4(ialngIndex, 1)
                        Set objCell = .FindNext(After:=objCell)
                    Loop Until objCell.Address = strFirsAddress
                    Set objCell = Nothing
                End If
            Next
            avntValues = .Value
            For ialngIndex = LBound(avntValues) To UBound(avntValues)
                If Not IsEmpty(avntValues(ialngIndex, 1)) Then _
                    If Not objDictionary.Exists(Key:=avntValues(ialngIndex, 1)) Then _
                    Call MsgBox("Fehler in Zeile " & CStr(ialngIndex), vbCritical, "Falsche Eintrag")
            Next
            Set objDictionary = Nothing
        End With
    End With

    Exit Sub
    Ende:
    '?
End Sub

Gruß
Nepumuk

Hallo Philip,
das kommt wenn man wichtige Informationen zurückhält.

Option Explicit

Public Sub SuchenErsetzen2()

    Dim avntName3 As Variant
    Dim avntName4 As Variant
    Dim avntValues As Variant
    Dim ialngIndex As Long
    Dim strFirsAddress As String
    Dim objCell As Range
    Dim objDictionary As Object

    On Error GoTo Ende

    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

    With Worksheets("Do-Not-Edit")
        avntName3 = .Range("F2:F" & CStr(.Cells(.Rows.Count, 1).End(xlUp).Row)).Value
        avntName4 = .Range("H2:H" & CStr(.Cells(.Rows.Count, 1).End(xlUp).Row)).Value
    End With

    With Worksheets("NSC")
        With .Range(.Cells(2, 20), .Cells(.Rows.Count, 20).End(xlUp))
            For ialngIndex = LBound(avntName3) To UBound(avntName3)
                objDictionary.Item(Key:=avntName3(ialngIndex, 1)) = vbNullString
                Set objCell = .Find(What:=avntName3(ialngIndex, 1), _
                    LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                If Not objCell Is Nothing Then
                    strFirsAddress = objCell.Address
                    Do
                        objCell.Offset(0, 27).Value = avntName4(ialngIndex, 1)
                        Set objCell = .FindNext(After:=objCell)
                    Loop Until objCell.Address = strFirsAddress
                    Set objCell = Nothing
                End If
            Next
            avntValues = .Value
            For ialngIndex = LBound(avntValues) To UBound(avntValues)
                If Not IsEmpty(avntValues(ialngIndex, 1)) Then _
                    If Not objDictionary.Exists(Key:=avntValues(ialngIndex, 1)) Then _
                    Call MsgBox("Fehler in Zeile " & CStr(ialngIndex + 1), vbCritical, "Falsche Eintrag")
            Next
            Set objDictionary = Nothing
        End With
    End With

    Exit Sub
    Ende:
    '?
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

VBA Script umbauen - replace

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread