Viele Formeln mit SVERWEIS korrigieren

Hallo zusammen,
in einem Excel-File mit ca. 100 Tabellenblättern befinden sich pro Tabellenblatt mehrere Spalten (und jeweils bis zu 100-200 Zeilen) mit der Formel SVERWEIS, teilweise auch verschachtelt.

=WENN(JAHR(F15)=2010;WENN(O15="";"";SVERWEIS(O15;'Std.-Sätze'!$B$20:$D$57;3)*I15);WENN(O15="";""; SVERWEIS(O15;'Std.-Sätze'!$B$20:$E$57;4)*I15))

Es feht in jedem SVERWEIS der letzte Parameter ("Bereich_Verweis") der den Wert "falsch" haben sollte, um eine genaue Übereinstimmung des Suchkriteriums aus der Matrix zu erhalten. Fehlt dieser Parameter gibt SVERWEIS nicht den gewünschten Wert zurück.
Aufgefallen ist mir dies beispielsweise, wenn das Suchkriterium ein U-Umlaut enthält.
1. Liegt dies an dem o.g. "Ü" im Suchkriterum ?
2. Gibt es eine Möglichkeit, alle SVERWEISE um diesen Parameter zu ergänzen, ohne dies in jedem Tabellenblatt manuell einzupflegen?
Gruß
Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

' ********************************************************************** ' Modul: Modul4 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Sub correctFormulas() Dim objSh As Worksheet Dim rng As Range, rngF As Range Dim lngStart As Long, lngEnd As Long Dim strFormula As String, strTmp As String Dim lngCalc As Long, lngCount As Long On Error GoTo ErrExit With Application .ScreenUpdating = False .EnableEvents = False lngCalc = .Calculation .Calculation = xlCalculationManual .DisplayAlerts = False End With For Each objSh In ActiveWorkbook.Worksheets Set rng = Nothing On Error Resume Next Set rngF = objSh.UsedRange.SpecialCells(xlCellTypeFormulas) On Error GoTo 0 If Not rngF Is Nothing Then For Each rng In rngF.Cells strFormula = rng.Formula lngStart = InStr(1, strFormula, "VLOOKUP(") If lngStart > 0 Then lngEnd = InStr(lngStart, strFormula, ")") strTmp = Mid(strFormula, lngStart, lngEnd - lngStart + 1) If UBound(Split(strTmp, ",")) = 2 Then strTmp = Replace(strTmp, ")", ",0)") strFormula = Left(strFormula, lngStart - 1) & strTmp & Mid(strFormula, lngEnd + 1) rng.Formula = strFormula lngCount = lngCount + 1 End If End If Next End If Next If lngCount > 0 Then MsgBox "Es wurden " & lngCount & " Formel(n) korrigiert!", vbInformation, "Hinweis" Else MsgBox "Keine Formeln zur Korrektur gefunden!", vbInformation, "Hinweis" End If ErrExit: With Err If .Number <> 0 Then MsgBox "Fehler in Prozedur:" & vbTab & "'correctFormulas'" & vbLf & String(60, "_") & _ vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _ "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _ .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _ "VBA - Fehler in Modul - Modul4" .Clear End If End With On Error GoTo 0 With Application .ScreenUpdating = True .EnableEvents = True .Calculation = lngCalc .DisplayAlerts = True End With Set rng = Nothing Set rngF = Nothing Set objSh = Nothing End Sub

Hallo Christian,
dann so.

' **********************************************************************
' Modul: Modul4  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub correctFormulas()
  Dim objSh As Worksheet
  Dim rng As Range, rngF As Range
  Dim lngStart As Long, lngEnd As Long
  Dim strFormula As String, strTmp As String
  Dim lngCalc As Long, lngCount As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  For Each objSh In ActiveWorkbook.Worksheets
    Set rng = Nothing
    On Error Resume Next
    Set rngF = objSh.UsedRange.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    If Not rngF Is Nothing Then
      For Each rng In rngF.Cells
        strFormula = rng.Formula
        lngStart = 0
        Do
          lngStart = InStr(lngStart + 1, strFormula, "VLOOKUP(")
          If lngStart > 0 Then
            lngEnd = InStr(lngStart + 1, strFormula, ")")
            strTmp = Mid(strFormula, lngStart, lngEnd - lngStart + 1)
            If UBound(Split(strTmp, ",")) = 2 Then
              strTmp = Replace(strTmp, ")", ",0)")
              strFormula = Trim$(Left(strFormula, lngStart - 1)) & Trim$(strTmp) & Trim$(Mid(strFormula, lngEnd + 1))
            End If
          End If
        Loop While lngStart > 0
        If rng.Formula <> strFormula Then
          rng.Formula = strFormula
          lngCount = lngCount + 1
        End If
      Next
    End If
  Next
  
  If lngCount > 0 Then
    MsgBox "Es wurden " & lngCount & " Formel(n) korrigiert!", vbInformation, "Hinweis"
  Else
    MsgBox "Keine Formeln zur Korrektur gefunden!", vbInformation, "Hinweis"
  End If
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'correctFormulas'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul4"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set rng = Nothing
  Set rngF = Nothing
  Set objSh = Nothing
End Sub

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

Viele Formeln mit SVERWEIS korrigieren

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Viele Formeln mit SVERWEIS korrigieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread