Re: Find-Methode (Rückgabewert)
13.09.2002 17:18:18
Oliver
Tja, ähh, also...Den Tabellennamen hab ich auf meinen angepasst, und ja, ich habe das Original hier aus dem Forum rauskopiert und bei mir eingefügt.
Wie mein Makro jetzt aussieht? Zumindest funktioniert es, bin aber noch mitten am enwickeln, hier mal ein Zwischenstand:
Sub Suchabgleich()
'
' SuchAbgleich Makro
' Makro am 12.09.02 von Oliver aufgezeichnet
'
' Tastenkombination: Strg+Umschalt+S
'
' Variablendeklaration:
Dim Zelle As Variant ' Zellenadresse
Dim intLang As Long ' Länge einer Nummer (Stellenanzahl)
Dim zaehler As Long ' Zählvariable für Schleifendurchgänge
Dim xGesucht As Variant ' Vorwahl
Dim xZwischen As Variant ' Nummer komplett im long-Format
Dim xKopf As Variant ' Kopfnummer
Dim Ergebnis As Variant ' Ergebnisvariable, in der die Ausgabenummer gespeichert wird
Dim Bereich As Range ' Range zum definieren von Suchspalten, -bereichen etc.
Dim suchBereich As Variant ' Bereichadresse zur Einschränkung des Suchbereichs
' Aufbereitung der Ausgangsdaten
'
' Länderkennzeichen und Telefonnummer werden verknüpft
zaehler = 3
Do
Zelle = "$C$" + Mid(Str(zaehler), 2, Len(Str(zaehler) - 1))
Sheets("Ausgangsdaten").Range(Zelle).Activate
ActiveCell.Value = ActiveCell.Offset(0, -2).Value & Mid(Str(ActiveCell.Offset(0, -1).Value), 2, Len(Str(ActiveCell.Offset(0, -1).Value) - 1))
zaehler = zaehler + 1
Loop While ActiveCell.Value <> "0"
ActiveCell.Value = Null
' Vergleich
'
'
' Suche
'
' Ausgangsnummer + Länderkennzeichen werden so lange um eine Stelle verkürzt,
' bis eine Vorwahl gefunden wird.
zaehler = 3
Do
Zelle = "$D$" + Mid(Str(zaehler), 2, Len(Str(zaehler) - 1))
Sheets("Ausgangsdaten").Range(Zelle).Activate
intLang = Len(ActiveCell.Offset(0, -1).Value)
xGesucht = Mid(ActiveCell.Offset(0, -1).Value, 1, intLang)
xZwischen = xGesucht
If xGesucht = "" Then Exit Sub
Select Case Mid(xGesucht, 1, 2)
Case "AT"
suchBereich = "E2:E2497"
Case "BE"
suchBereich = "E2498:E2556"
Case "CH"
suchBereich = "E2557:E2620"
Case "DE"
suchBereich = "E2621:E7879"
Case "DK"
suchBereich = "E7880:E7888"
Case "ES"
suchBereich = "E7889:E7982"
Case "FI"
suchBereich = "E:E"
Case "FR"
suchBereich = "E:E"
Case "GB"
suchBereich = "E:E"
Case "IE"
suchBereich = "E:E"
Case "IT"
suchBereich = "E:E"
Case "LU"
suchBereich = "E:E"
Case "NL"
suchBereich = "E:E"
Case "NO"
suchBereich = "E:E"
Case "PT"
suchBereich = "E:E"
Case "SE"
suchBereich = "E:E"
End Select
Sheets("Referenz").Activate
With Worksheets("Referenz")
Set Bereich = Range(suchBereich).Find(What:=xGesucht, LookIn:=xlValues)
Do While (Bereich Is Nothing) And (xGesucht <> "")
intLang = intLang - 1
xGesucht = Mid(xGesucht, 1, intLang)
Set Bereich = Range(suchBereich).Find(What:=xGesucht, LookIn:=xlValues)
Loop
End With
zaehler = zaehler + 1
' Formatierte Ausgabe der Vorwahl in Ergebnisvariable
'
' Gefundene Vorwahl wird ohne Länderkennzeichen ausgegeben.
' Format: "(0" + Nummer ohne Länderkennzeichen + ")"
' Außer: Länderkennzeichen ist ES, IT oder SE, dann
' "(" + Nummer ohne Länderkennzeichen + ")"
Sheets("Ausgangsdaten").Activate
intLang = Len(xGesucht) - 2
If intLang <= 0 _
Then Ergebnis = "Keine Vorwahl gefunden!!!" _
Else Select Case Mid(xGesucht, 1, 2)
Case "ES", "IT", "SE"
Ergebnis = "(" & Mid(xGesucht, 3, intLang) & ")"
Case Else
Ergebnis = "(0" & Mid(xGesucht, 3, intLang) & ")"
End Select
' Range(Zelle).Value = Ergebnis & Mid(xZwischen, intLang + 3, Len(xZwischen) - intLang - 2)
Loop While Zelle <> ""
End Sub