Formel CountIF

[atilla]

Hallo,

in der eingestellten Mappe war  aber kein Code von mir.

Aber Da Du 1P ersetzt hast, musst Du bei Dir meinen Code verwendet haben.
Das müsstest Du auch an der benötigten Zeit merken, welchen code Du verwendest.

Um nicht auf 1P oder 3P achten zu müssen, können die letzten 3 Zeichen auch ganz entfallen.

Folgender Code braucht dann nicht angepasst werden:

Code:

Sub mach1()
 Dim i As Long, j As Long, jj As Long, x As Long

 Dim lngZKurz As Long, lngZLang As Long
 
 lngZKurz = Cells(Rows.Count, 1).End(xlUp).Row
 lngZLang = Cells(Rows.Count, 3).End(xlUp).Row
 Dim strgT As String
 
 Dim ati, ati_ati, ati_1, ati_2
 
 Range("B3:B" & lngZLang).ClearContents
 ati = Range("A3:A" & lngZKurz)
 ati_ati = Range("A3:A" & lngZKurz)
 ati_1 = Range("B3:B" & lngZLang)
 ati_2 = Range("C3:C" & lngZLang)
 
 For i = 1 To UBound(ati)
   strgT = Left(ati(i, 1), Len(ati(i, 1)) - 3) & "*"
   jj = Application.CountIf(Range("C3:C" & lngZLang), strgT)
   If jj > 0 Then
     ati_ati(i, 1) = ""
     x = Application.Match(strgT, ati_2, 0)
     For j = 1 To jj
       ati_1(x + j - 1, 1) = ati(i, 1)
     Next
   End If
 Next i
 
 Range("A3:A" & lngZKurz) = ati_ati
 Range("B3:B" & lngZLang) = ati_1

End Sub

[elgato2000]

OK, super Danke !!

[atilla]

Hallo,

weil's Spaß gemacht hat unten Deine Datei mit Erweiterungen.

Die Suche wird mehrmals ausgeführt.
1. Kurznamen in Langnamen, verbleibende in A; Ergebnis in Spalte B
2. Teil bis erstes Leerzeichen in Kurznamen in Langnamen; Ergebnis in Spalte D
3. Erster und zweiter Teil bis Leerzeichen in Langnamen zusammengelegt und in Kurznamen gesucht; Ergebnis in Spalte E
Also in den Spalten  B, D und E sind Ergebnisse



In Spalte A stehen am Ende die nicht gefundenen Werte
Wenn sie alphabetisch einsortiert werden können, dann werden sie in der Höhe der Anfangsbuchstaben von Spalte C einsortiert.
wenn nicht, dann sind sie in Spalte G in der Zeile in der sie zu Beginn waren.

Von 704 Kurznamen bleiben am Ende In Spalte A 177 und in Spalte G noch 2

Jetzt wo ich so viel geschrieben habe, fällt mir ein, dass Du Dir sowieso keine Mühe machst die Beiträge vernünftig zu lesen.
Aber ich lösch das jetzt nicht.

Ich stell dafür die Datei nicht ein.   :19:




Ach, was soll's:

  Kopie von NeueSkus.xlsm (Größe: 105,75 KB / Downloads: 3)

[elgato2000]

na klar lese ich alles genaustens ;)

Super nochmal vielen vielen Dank.

Morgen sind die 4erP, 4LP, MFP, Pano und 1K dran

Guts Nächtle

[elgato2000]

Hallo Atilla


Du hast mir wirklich sehr geholfen ! Danke !!!!!!

Jetzt muss ich noch die fehlenden machen.

Schau Dir doch bitte mal das angehängte Workbook an.

Spalte B müsste umformatiert werden wie die Beispiele in Spalte A.

Beispiel: AlteWeltkarteV2_1p > Alte Weltkarte V2 1P

Ist das sehr kompliziert ? Es sind auch ein paar Zahlen dabei, die müssen natürlich nicht umformatiert werden...

Grüße!

[atilla]

Hallo,

da haben wir ja mal eine einfache Aufgabenstellung.

Und hier die banale Lösung:

Code:

Sub mach_mal()
  Dim i As Long, j As Long
  Dim lngZ As Long
  Dim SuchenNach As String
  Dim ErsetzenDurch As String
  Dim ati
 
  SuchenNach = "?1p"
  ErsetzenDurch = " 1p"

  lngZ = Cells(Rows.Count, 2).End(xlUp).Row
   Range("B1:B" & lngZ).Replace What:=SuchenNach, Replacement:=ErsetzenDurch, LookAt:=xlPart, SearchOrder _
  :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

  ati = Range("B1:B" & lngZ)

  For i = 1 To lngZ
    For j = 2 To Len(ati(i, 1))
      If Mid(ati(i, 1), j, 2) Like "[a-z][A-Z]" Then
        ati(i, 1) = Left(ati(i, 1), j) & " " & Right(ati(i, 1), Len(ati(i, 1)) - j)
        j = j + 1
      End If
    Next j
  Next i
 
  Range("A1:A" & lngZ) = ati
End Sub

[elgato2000]

Ja super, wirklich so einfach ?

DANKE !!!!!!!!!!