Typen unverträglich
#1
Hallo,

Ich möchte eine makro schreiben mit der man eine zahl aus einer zelle extrahieren kann. Leider erhalte ich die Fehlermeldung "typen verträglich". Woran liegt das? Hier ist der code:

Private Function extractnumber(byval str As string) As long
Dim t as byte, tt As byte
Extractnumber = str

For t = 1 to len(str)
....
.....

If isnumeric(mid(str, t, 1))

....
....
....

Extractnumber = Mid(str, t, len(str) - (tt - t)   <--- wird markiert

....
....

End function


Exit for end if kommt am ende des codes

Würde mich über hilfe oder tipps freuen
Gru
Top
#2
Antwort gelöscht, war Quatsch!
Top
#3
Hallo,

ich weiß nicht genau was Du machst, aber hier eine funktionierende Lösung:


Code:
Sub test()
 MsgBox extractnumber("a1vb3")
End Sub

Private Function extractnumber(ByVal str As String) As Long
Dim t As Byte

For t = 1 To Len(str)
 If IsNumeric(Mid(str, t, 1)) Then
   extractnumber = Mid(str, t, 1)
   Exit For
 End If
Next t
End Function
Gruß Atilla
Top
#4
Hallo ,

hier noch eine Alternative:

Code:
Option Explicit

Sub test()
Const TEST_STRING As String = "Blabla12312323Blabda"
MsgBox extractNumbers(TEST_STRING)
End Sub

Private Function extractNumbers(ByVal strMatch) As Long
   Dim regex As Object
   Set regex = CreateObject("vbscript.regexp")
   With regex
       .Pattern = "([^0-9]*)(\d+)([^0-9]*)"
       If .test(strMatch) Then
       extractNumbers = .Replace(strMatch, "$2")
       End If
   End With
End Function
Top
#5
Danke, ich probiers später aus. Hier ist meine excel datei, leider erhalte ich noch eine Fehlermeldung. Markiert wird "Set ws = tabelle1, Variable nicht definiert. Könnt ihr euch das mal ansehen? Ich möchte die Spalte A in Tabelle 1 nach bestimmten wörtern durchsuchen und diese durch andere ersetzen. Das kann  ich in tabelle 2 festlegen.

Der code steht im visual projekt editor bei Tabelle1. Ein Modul möchte ich nicht einfügen.

Gruß


Angehängte Dateien
.xlsm   112535.xlsm (Größe: 22,91 KB / Downloads: 7)
Top
#6
Hallo,

(31.03.2017, 14:26)Leo223excel schrieb: leider erhalte ich noch eine Fehlermeldung. Markiert wird "Set ws = tabelle1, Variable nicht definiert.

ich erhalte die Fehlermeldung nicht. Hast Du die richtige Datei hochgeladen?
Gruß Stefan
Win 10 / Office 2016
Top
#7
Müsste die richtige sein. Ich kann erst später nachschauen. Ich möchte kein modul verwenden, der code soll im vba projekt editor bei Tabelle1 stehen. Kann sein dass ich es bei der datei anders gemacht habe. Das modul dann bitte löschen.

Aber es kommen doch bestimmt Fehlermeldungen. Der code ist so nicht richtig.
Top
#8
hier ist die Datei. Der Code soll im Tabellenblattmodul stehen. Unterhalb davon gibts noch einen Ordner mit dem Namen Module und darin befindet sich ein Modul1. Der Code soll aber nicht da drin stehen.


Angehängte Dateien
.xlsm   Suchen und Ersetzen - Kopie.xlsm (Größe: 20,6 KB / Downloads: 7)
Top
#9
Hallo,

ich habe es so gelöst:


Code:
Sub test()
Dim i As Long, j As Long, n As Long
Dim lngZSuch As Long
Dim lngZErgebnis As Long
Dim suchT As String
Dim ati, varT
With Sheets("Suchbegriffe")
  lngZSuch = .Cells(Rows.Count, 1).End(xlUp).Row
  ati = .Range("A2:B" & lngZSuch)
End With

With Sheets("Tabelle1")
  lngZErgebnis = .Cells(Rows.Count, 1).End(xlUp).Row
  Range("B3:B" & lngZErgebnis).ClearContents
  For i = LBound(ati) To UBound(ati)
    varT = Split(ati(i, 1))
      suchT = "*" & Join(varT, "*") & "*"
    For j = 3 To lngZErgebnis
      If .Cells(j, 1) Like suchT Then
        varT = Split(.Cells(j, 1))
        For n = UBound(varT) To LBound(varT) Step -1
          If IsNumeric(varT(n)) Then Exit For
        Next n
        .Cells(j, 2) = ati(i, 2) & "-" & varT(n)
      End If
    Next j
  Next i
End With

End Sub


Geschrieben wird in die Spalte B von Tabelle1

Ich habe ein Ergebnis abweichend deines.
Wobei ich wahrscheinlich richtig liege.
Gruß Atilla
Top
#10
Vielen Dank! Es klappt. Ich hab der Schaltfläche die falsche Makro zugewiesen, so kanns natürlich nicht gehen. Tut mir leid, aber jetzt gehts, ich habs irgendwie übersehen.

'Entwurfsmodus', Button mit rechts anklicken --> Makro zuweisen --> Diese Arbeitsmappe.

Gruß
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste