Read Wildcard als Asterisk

Question

Ich hatte ein Stück Code in dieser Woche in Auftrag gegeben (billiger, um einen Experten zu haben, schreiben Sie es als für mich eine Woche zu verbringen versuchen!). Aber wenn ich es benutze, habe ich einen kleinen Haken gefunden.

Das Makro sucht nach einem Namen in einem Excel-Arbeitsblatt, gleicht es mit einer Liste von Namen und zugehörigen ID-Nummern in einem anderen Arbeitsblatt ab und fügt dann die ID in das erste Arbeitsblatt ein. Das war alles in Ordnung, bis ich begann, es mit echten Daten zu verwenden.

Hier einige Beispieldaten (alle diese Informationen in einer Zelle ist ...):

WARHOL *, Andy

PETO, John F

D3 GRECO, Emilio bis 20. C

Haseltine, William Stanley

D3 DALI, Salvador

D3 SOSNO, Sacha

WEGMAN **, WILLIAM

Ein Stern bedeutet es einen Druck ist, zwei eine Fotografie, D3 eine Skulptur, und nichts ein Gemälde.

Wenn ich den Code mit diesen Daten ausführen, sieht es * als Platzhalter und wird immer die ID der ersten Variante des Künstlers in das Blatt einfügen. Was ich brauche, ist eine Möglichkeit für das Makro, es nicht als Platzhalter zu lesen.

Ich habe einige Nachforschungen gemacht, und festgestellt, dass das Einfügen von ~ vor * die Wildcard-Eigenschaften negiert. Wie würde ich meinen Code dazu bringen? Ich habe das Hauptproblem entdeckt, Code von jemand anderem geschrieben zu haben ... Du wirst es vielleicht nicht verstehen! Hier

ist der Code:

Public Sub match_data() 
'ctrl+r 
On Error GoTo errh 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

Dim r1, r2, i, exc As Long 
Dim fp As Range 

Sheets("Data").Activate 

r1 = Cells(Rows.Count, "B").End(xlUp).Row 
r2 = Sheets("List").Cells(Sheets("List").Rows.Count, "B").End(xlUp).Row 

'MsgBox r1 & r2 

exc = 0 

For i = 2 To r1 
    If Range("B" & i).Value <> "" Then 
     With Sheets("List").Range("B2:B" & r2) 
      Set fp = .Find(Range("B" & i).Value, LookIn:=xlValues, lookat:=xlWhole) 

     If Not fp Is Nothing Then 
      Range("B" & i).Interior.Color = xlNone 
      Range("A" & i).Value = Sheets("List").Range("A" & fp.Row).Value 
     Else 
      Range("B" & i).Interior.Color = xlNone 
      Range("B" & i).Interior.Color = vbYellow 
      exc = exc + 1 
     End If 

    End With 
End If 
Next i 

MsgBox "There are " & exc & " exceptions." 

errh: 
If Err.Number > 0 Then 
    MsgBox Err.Description 
End If 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 
End Sub 

Oh auch, würde ich dies tun müssen für die Liste der Namen und IDs würde ich nicht? Wenn ja, das muss nur einmal gemacht werden, also wenn du mir einen Hinweis darüber geben könntest, wäre ich so dankbar!

Danke!

PS Ich kenne das System, das wir im Moment absolut saugt (definitiv nicht 3. Form normalisiert!), Aber wir haben schnell keine Zeit und Geld mehr, und müssen unser Produkt so schnell wie möglich!

EDIT: Um zu klären, hier ein Bild der Tabellen ist arbeite ich mit ... Offensichtlich in Zellen A14 und A15 ich die ID-Nummern 11 & 12 bzw.

Answer 1

okay, ich habe s hat das Problem gelöst! Ich habe mit dem Ändern der Variablen im Feld Suchen und Ersetzen herumgespielt.

Wenn ich setze ~ * sowohl in der Entdeckung und Boxen ersetzen, und deaktivieren Spiel gesamten Zellinhaltes, kann ich alle der ersetzen * mit ~ * (wirklich nicht verstehen, dass aber na ja!)

Also mache ich dies auf dem Arbeitsblatt Daten, aber NICHT auf dem Arbeitsblatt Liste, führe das Makro normal aus und das Problem ist gelöst!

Answer 2

Hier wollte, ist eine Möglichkeit, die Sterne von den Planeten zu sagen:

Sub StaryNight() 
    Dim s As String, OneStar As String, TwoStar As String, ThreeStar As String 

    OneStar = "*" 
    TwoStar = "**" 
    ThreeStar = "***" 
    t = Range("A1").Text 
    ary = Split(t, ",") 
    s = ary(0) 

    If Right(s, 3) = ThreeStar Then 
     MsgBox "scupture" 
     Exit Sub 
    ElseIf Right(s, 2) = TwoStar Then 
     MsgBox "photograph" 
     Exit Sub 
    ElseIf Right(s, 1) = OneStar Then 
     MsgBox "print" 
     Exit Sub 
    End If 

    MsgBox "Painting" 
End Sub