Formel CountIF

[atilla]

Hallo,

mit den erweiterten Vorgaben bekomme ich noch einige Ergebnisse mehr:

Arbeitsblatt mit dem Namen 'Amazon DE'
	A	B	C	D
1		664		525
2	Kurzname	Atilla	Langname	Ego
3	3D 1P	3D 1P	3D Digital Art 1p	3D 1P
4	Abstract 1P		5th Avenue mit Yellow Cabs in New York City 1p
5	Abstract V2 1P	Abstract 1P	Abstract Beauty 1p	Abstract 1P
6	Abstraktes Herz 1P	Abstract V2 1P	Abstract V2 1p	Abstract V2 1P
7	Aces 1P	Abstraktes Herz 1P	Abstraktes Herz Strassenkunst Street Art 1p	Abstraktes Herz 1P
8	Adler 1P		Abstraktes Werk 1p
9	Afrika 1P	Aces 1P	Aces Poker Casino Spielhalle Kartenspiel 1p	Aces 1P
10	Algarve 1P	Adler 1P	Adler Weisskopfseeadler USA Symbol 1p	Adler 1P
11	Ali 1P		African Beauty 1p
12	Alone 1P	Afrika 1P	Afrika 1p	Afrika 1P
13	Alpen 1P		Al Pacino Scarface 1p
14	Alpenwiese 1P	Algarve 1P	Algarve Strand 1p	Algarve 1P
15	Alster 1P	Ali 1P	Ali Muhammad 1p	Ali 1P
16	Alte Uhren 1P	Alone 1P	Alone 1p	Alone 1P
17	Alte Weltkarte 1P	Alpen 1P	Alpen 1p Berge Tirol
18	Alter Leuchtturm 1P	Alpenwiese 1P	Alpenwiese Alpen Bayern 1p	Alpenwiese 1P
19	Amischlitten 1P	Alster 1P	Alster Hamburg 1p	Alster 1P
20	Amsterdam V2 1P		Alte Kamera Fotoapparat Wie Leica 1p
21	Amsterdam V3 1P		Alte Kamera Sepia Fotoapparat wie Leica Vintage 35mm 1p
22	AmsterdamV2 1P	Alte Uhren 1P	Alte Uhren 1p	Alte Uhren 1P
23	Apfel 1P	Alte Weltkarte 1P	Alte Weltkarte V2 1p	Alte Weltkarte 1P
24	Apples 1P	Alte Weltkarte 1P	Alte Weltkarte V3 1p	Alte Weltkarte 1P
25	Arizona 1P	Alte Weltkarte 1P	Alte Weltkarte Vintage 1p	Alte Weltkarte 1P
26	Astronaut 1P		Alter Baum Landschaft Natur Grün 1p
27	Atmo 1P		Alter Chevy V2 Arizona 1p
28	Atmospheric 1P		Alter Ford T-Modell Route 66 1p
29	Audrey 1P	Alter Leuchtturm 1P	Alter Leuchtturm 1p Dünen Nordsee
30	Audrey V2 1P		Altes Fahrrad im Feld mit Sonne Nostalgie 1p
31	Audrey V7 1P		Altstadt 1p
32	Auf dem Mond 1P		Amerika vom Weltall 1p
33	Auge 1P	Amischlitten 1P	Amischlitten 1p	Amischlitten 1P
34	Ayers Rock 1P	Amischlitten 1P	Amischlitten V2 1p	Amischlitten 1P
35	Ayers Rock V2 1P	Amischlitten 1P	Amischlitten V3 1p	Amischlitten 1P
36	Balance 1P	Amsterdam V2 1P	Amsterdam V2 1p	Amsterdam V2 1P
37	Balloons 1P	Amsterdam V3 1P	Amsterdam V3 Grachten Häuserzeile 1p	Amsterdam V3 1P
38	Balls 1P		Antelope Canyon Arizona 1p
39	Bamboo 1P	Apfel 1P	Apfel 1p	Apfel 1P
40	Bangkok 1P	Apfel 1P	Apfel Wasser 1p Früchte Küche
41	Banksy 1P	Apples 1P	Apples 1p	Apples 1P
42	Banksy V2 1P		Aquarell 1p
43	Banksy V3 1P		Aquarell 1p
44	Baseball 1P		Aquarium Fische Meerwasser Tropische Doktorfische 1p
45	Baum am See 1P		Ara Papagei 1p
46	Bäume 1P	Arizona 1P	Arizona 1p USA

Zelle	Formel
B1	=ANZAHL2(B3:B1022)
D1	=ANZAHL2(D3:D1022)

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

[atilla]

der Code fehlte noch:

Code:

Option Explicit

Sub mach()
  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_1, ati_2
 
  Range("B3:B" & lngZLang).ClearContents
  ati = Range("A3:A" & lngZKurz)
  ati_1 = Range("B3:B" & lngZLang)
  ati_2 = Range("C3:C" & lngZLang)

  For i = 1 To UBound(ati)
    strgT = Replace(ati(i, 1), " 1P", "*", 1, , vbTextCompare)

    jj = Application.CountIf(Range("C3:C" & lngZLang), strgT)
    If jj > 0 Then
      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("B3:B" & lngZLang) = ati_1

End Sub

[elgato2000]

Super Atilla, tausend Dank ! Wie hast DU es geschafft, noch mehr Ergebnisse zu erzielen ? Echt super !!!

[elgato2000]

Eine kleine Schönheitskorrektur vielleicht noch:

In Spalte A diejenigen Kurznamen löschen, die das Macro in Spalte B eingetragen hat.

Dann bleiben nur noch die übrig, zu denen keine Zuordnung möglich war !

Was meinst Du Atilla ?

[atilla]

.... Wie hast DU es geschafft, noch mehr Ergebnisse zu erzielen ? .....

Hallo,

ich habe meiner Frau und meinen Kindern jedem einen Teil der Tabelle vorgelegt und suchen lassen.
Das kann ich aber nicht noch ein mal machen. Heute morgen kamen die Kinder gar nicht aus dem Bett, weil es gestern so spät wurde.

Deine weitergehende frage kann ich erst später wieder beantworten.

[elgato2000]

Hallo,

ich habe meiner Frau und meinen Kindern jedem einen Teil der Tabelle vorgelegt und suchen lassen.
Das kann ich aber nicht noch ein mal machen. Heute morgen kamen die Kinder gar nicht aus dem Bett, weil es gestern so spät wurde.

Deine weitergehende frage kann ich erst später wieder beantworten.

:19:
Atilla !!!!! Bist Du denn verrückt

Weiß gar nicht weiß ich sagen soll ! :18:  Der ist für Dich

[atilla]

Hallo,

das ging mit einer kleinen Anpassung recht einfach:

Code:

Sub mach2()
 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 = Replace(ati(i, 1), " 1P", "*", 1, , vbTextCompare)

   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

Wie wäre es, wenn man jetzt noch die übriggebliebenen ab den Anfangsbuchstaben in B einsortiert? :19:

[elgato2000]

... echt klasse, Atilla ! So passt es ...

Mal sehen, wie das Macro jetzt mit den verbleibenden 4500+ Zeilen funktioniert. Das waren ja jetzt "erst" rund 1000 Zeilen ...

[elgato2000]

Hallo Atilla,

nachdem der erste "Schwung" ja gut geklappt hat, macht das Macro jetzt bei den nächsten 1000 Probleme.

Kannst Du mal schauen woran es liegt ?

[elgato2000]

Hallo Atilla,

nachdem der erste "Schwung" ja gut geklappt hat, macht das Macro jetzt bei den nächsten 1000 Probleme.

Kannst Du mal schauen woran es liegt ?

Hab's schon gefunden ... im Code war " 1P" geschrieben ... dass habe ich für diesen Schwung auf " 3P" abgeändert