Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1244to1248
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Like Operation

Like Operation
mehmet
Hallo,
ich komme mit Like Operation nicht weiter.
Ich habe ein paar Möglichkeiten ausprobiert, geht aber nicht: 'Like Operation '? Ein beliebiges einzelnes Zeichen '* Null oder mehrere Zeichen '# Beliebige einstellige Ziffer [0-9] 'Wenn Himmelsrichtungen angegeben, dann eintragen (17 ist Spalte Q) wo kommt 'Möglichkeit 1 If arr(4) Like ["####SW" Or "####NW" or "####SE" Or "####NE" or "####S" Or "####N" Or "####E" _ Or "####W" Or "NSC"] = True Then Cells(iRow, 17).Value = arr(4) iAdd = iAdd + 1 End If 'Möglichkeit 2 If arr(4) Like "####SW" Or arr(4) Like "####NW" _ Or arr(4) Like "####SE" Or arr(4) Like "####NE" _ Or arr(4) Like "####S" Or arr(4) Like "####N" _ Or arr(4) Like "####E" Or arr(4) Like "####W" _ Or arr(4) Like "NSC" = True Then Cells(iRow, 17).Value = arr(4) iAdd = iAdd + 1 End If
Woran könnte es liegen?
Wäre nett, wenn Ihr mir ein Tip geben könntet.
Herzlichen Dank
Gruss
Mehmet
Sinnvoll ist nur M2, allerdings ohne =True, ...
10.01.2012 08:35:14
Luc:-?
…Mehmet,
denn das steht auch nicht in der Hilfe zu Operator Like! Like ist ein VglsOperator, kein Boolescher Ausdruck, der aber durch die Or entsteht! Besser ist, das alles separat zu fassen, sofern es sich nicht in einem Vglsausdruck unterbringen lässt wie bspw so …
If arr(4) Like "####[SNEW]" Then als eine Variante, die dann weiter untersucht wdn muss, um ein abschließendes Ergebnis zu erhalten. Dafür gibt's dann noch die üblichen If … Then … Else … bzw Select Case oder als vbFktt IIf und Switch. Zu beachten ist bei Like, dass # für eine einzelne beliebige Ziffer steht.
Ja, und außerdem gibt's ja noch die regulären Ausdrücke!
Morrn, Luc :-?
Anzeige
AW: Sinnvoll ist nur M2, allerdings ohne =True, ...
10.01.2012 10:24:10
mehmet
Hallo Luc,
dank dir.
Es will nicht 8-(
Jetzt habe ich

If arr(4) Like "####[SNEW]" Then
Cells(iRow, 17).Value = arr(4)
iAdd = iAdd + 1
End If

versucht.
Die Sache ist die, sobald in Zelle ein String mit langer Text z.B.:
DFGFG FDG123 DFG21F3 21FGDF3 1234NW WE
steht, dann soll 1234NW übergeben werden. Also immer 4stellige Zahl mit 1 oder 2 Buchstaben.
Wie mache ich denn hier ein or (also oder) Anweisung? so das ich sagen kann ####N or ####NW or ####S usw.
Das, was oben steht klappt nur mit 4stellige Zahl mit einem Buchstabe und wenn die Zahlen Nullen sind
Aber wie sähe es denn aus mit Select Case?
Dank Dir
Gruss
Mehmet
Anzeige
AW: Sinnvoll ist nur M2, allerdings ohne =True, ...
10.01.2012 12:21:29
mehmet
Hallo Luc,
ich hab mal herum experimentiert
Ich glaube, dass mit Like ist nicht was ich brauche.
Es sucht nach genau ab der vierte Array den String.
Der besagte String kann aber überall in der Zelle stehen.
Was kann ich ich den da nehmen statt Like?
Beispiele:
Zelle AG18: LSGG 101050Z VRB02KT 9999N FEW014 06/02 Q1033 NOSIG
Zelle AG19: LROP 101100Z VRB02KT CAVOK 0150SW 05/M01 Q1020 880///95 NOSIG
Zelle AG20: LBSF 28004MPS 8000E 9999 SCT017 BKN062 01/M02 Q1020 R99/19//95 NOSIG
usw. (AG6:AG80)
Für Zelle AG18 soll der Wert 9999N in Splate q18 eingetragen werden
Für Zelle AG19 soll der Wert 0150SW in Spalte q19 eingetragen werden
Für Zelle AG20 soll der Wert 8000E in Spalte q20 eigetragen werden
usw. (q6:q80)
Wenn die gesuchten Strings bis String Q#### (Buchstabe Q + vier stellige Zahl) nicht vorhanden, dann nächste Zeile
Hast du ein ansatz für mich bitte
Dank Dir
Gruss
Mehmet
Anzeige
Komme ich erst später dazu! Gruß owT
10.01.2012 17:37:07
Luc:-?
:-?
AW: Sinnvoll ist nur M2, allerdings ohne =True, ...
10.01.2012 17:54:45
Josef

Hallo Mehmet,
anbei ein Beispiel mit einer kleinen UDF.
Tabelle2

 PQAG
17   
18 9999NLSGG 101050Z VRB02KT 9999N FEW014 06/02 Q1033 NOSIG
19 0150SWLROP 101100Z VRB02KT CAVOK 0150SW 05/M01 Q1020 880///95 NOSIG
20 8000ELBSF 28004MPS 8000E 9999 SCT017 BKN062 01/M02 Q1020 R99/19//95 NOSIG
21   

Formeln der Tabelle
ZelleFormel
Q18=EXTRACT(AG18;" [0-9]{4}[A-Z]{1,2}")


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
https://www.herber.de/bbs/user/78348.xls

« Gruß Sepp »

Anzeige
ändere den Code der UDF ...
10.01.2012 18:00:29
Josef
... folgendermaßen, hatte noch einen kleinen Fehler drin.
Public Function EXTRACT(ByVal Text As String, ByVal Pattern As String) As String
  Dim vntPos As Variant
  
  vntPos = InStrREGEXP(Text, Pattern, True)
  
  If IsArray(vntPos) Then
    EXTRACT = Trim$(Mid(Text, vntPos(0), vntPos(1)))
  End If
End Function


Private Function InStrREGEXP(ByVal Text, ByVal Pattern, Optional ByVal IgnoreCase = False) As Variant
  Dim objRegEx As Object, objM As Object, objMC As Object
  Dim lngOut(1) As Long
  Set objRegEx = CreateObject("VBScript.RegExp")
  With objRegEx
    .Pattern = Pattern
    .IgnoreCase = IgnoreCase
    Set objMC = .Execute(Text)
    For Each objM In objMC
      lngOut(0) = objM.Firstindex + 1
      lngOut(1) = objM.Length
      InStrREGEXP = lngOut
      Exit For
    Next
  End With
  
End Function


Anzeige
AW: ändere den Code der UDF ...
11.01.2012 00:49:49
mehmet
Hallo Sepp,
herzlichen Dank für deine Hilfe. Dein Code läuft wunderbar. Ich habe versucht es mit anderen Sachen aber es will nicht:
=EXTRACT(AG18;" [A-Z]{1,2,3}[0-9]{3}")
=EXTRACT(AG18;" [A-Z]{3}[0-9]{3}")
=EXTRACT(AG18;" [A-Z]{1,2,3}[0-9]{1,2,3}")
soll zeigen z.B. AG18 die Werte FEW014 und in AG20 die Werte SCT017 BKN062
also immer 3Buchstaben+3Zahlen. Kann man das so machen?
Dank Dir
Gruss
Mehmet
AW: ändere den Code der UDF ...
11.01.2012 01:15:41
Josef

Hallo Mehmet,
die Funktionen ein wenig angepasst, dann geht auch das.
Tabelle2

 OPQAG
17    
18FEW014 9999NLSGG 101050Z VRB02KT 9999N FEW014 06/02 Q1033 NOSIG
19  0150SWLROP 101100Z VRB02KT CAVOK 0150SW 05/M01 Q1020 880///95 NOSIG
20SCT017BKN0628000ELBSF 28004MPS 8000E 9999 SCT017 BKN062 01/M02 Q1020 R99/19//95 NOSIG
21    

Formeln der Tabelle
ZelleFormel
O18=EXTRACT(AG18;" [A-Z]{2,3}[0-9]{3}")
P18=EXTRACT(AG18;" [A-Z]{3}[0-9]{3}";2)
Q18=EXTRACT(AG18;" [0-9]{4}[A-Z]{1,2}")


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Und hier der neue Code.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Function EXTRACT(ByVal Text As String, ByVal Pattern As String, Optional Index As Integer = 1, Optional ByVal MatchCase As Boolean = True) As String
  Dim vntPos As Variant
  
  vntPos = InStrREGEXP(Text, Pattern, Index, Not MatchCase)
  
  If IsArray(vntPos) Then
    EXTRACT = Trim$(vntPos(2))
  End If
End Function


Private Function InStrREGEXP(ByVal Text As String, ByVal Pattern As String, Optional Index As Integer = 1, Optional ByVal IgnoreCase As Boolean = False) As Variant
  Dim objRegEx As Object, objSubMatch As Object, objMatch As Object
  Dim vntOut(2) As Variant, intC As Integer, intIndex As Integer
  
  'PARAMETERINFO: Text = Der zu überprüfenden Text
  ' Pattern = Das Suchmuster
  ' Count = Bei mehreren Treffen, Index des zurückgegebenen Treffers
  ' IgnoreCase = Groß/Klein-Schreibung beachten
  'RÜCKGABEWERTE: Bei einem Treffer wird ein Datenfeld (0 To 2) zurückgegeben
  ' Feld(0) = Startposition des Treffers
  ' Feld(1) = Länge des Treffers
  ' Feld(2) = Inhalt des Treffers (Teilstring von 'Text')
  ' Wenn kein Treffer erzielt wird, ist der Rückgabewert ein Leerstring
  
  Set objRegEx = CreateObject("VBScript.RegExp")
  With objRegEx
    .Pattern = Pattern
    .IgnoreCase = IgnoreCase
    .Global = True
    Set objMatch = .Execute(Text)
    If objMatch.Count > 0 Then
      For Each objSubMatch In objMatch
        If intIndex = Index - 1 Then
          vntOut(0) = objSubMatch.Firstindex + 1
          vntOut(1) = objSubMatch.Length
          vntOut(2) = objSubMatch.Value
          InStrREGEXP = vntOut
          Exit For
        End If
        intIndex = intIndex + 1
      Next
    End If
  End With
End Function



« Gruß Sepp »

Anzeige
AW: ändere den Code der UDF ...
11.01.2012 03:05:36
mehmet
Hallo Sepp,
ist echt toll. Ich sitze hier schon mehrere Stunden und passe mein Sheet an. Funktioniert wunderbar.
Sei mir nicht böse aber eine Frage hätte ich noch bitte falls möglich:
Bsp:
EFHK 110120Z VRB04KT 9999 FEW003 BKN011 OVC065 M02/M02 Q1011 0439//33 5439//34 1539//35 BECMG BKN009 OVC002.
Also die vier Sachen konnte ich meinem Sheet anpassen FEW003 BKN011 OVC065 und eine Zusatzspalte falls vorhanden wäre.
Diese Strings können also bis zu 4 mal direkt hintereinander auftauchen.
Am Ende steht aber noch BKN009 und OVC002. Diese soll er nicht anzeigen. Alles was ab Buchstabe Q+4stelligeZahl (hier im Bsp Q1011) nicht mehr zeigen.
Danke Dir
Gruss
Mehmet
Anzeige
AW: ändere den Code der UDF ...
11.01.2012 07:42:06
Josef

Hallo Mehmet,
dazu muss man EXTRACT() zweimal einsetzen.
Tabelle2

 LMNOPQAG
21       
22 FEW003BKN011OVC065  EFHK 110120Z VRB04KT 9999 FEW003 BKN011 OVC065 M02/M02 Q1011 0439//33 5439//34 1539//35 BECMG BKN009 OVC002
23       

Formeln der Tabelle
ZelleFormel
M22=EXTRACT(EXTRACT($AG$22;"^.*(?=Q[0-9]{4})"); "[A-Z]{3}[0-9]{3}";SPALTE(A1))
N22=EXTRACT(EXTRACT($AG$22;"^.*(?=Q[0-9]{4})"); "[A-Z]{3}[0-9]{3}";SPALTE(B1))
O22=EXTRACT(EXTRACT($AG$22;"^.*(?=Q[0-9]{4})"); "[A-Z]{3}[0-9]{3}";SPALTE(C1))
P22=EXTRACT(EXTRACT($AG$22;"^.*(?=Q[0-9]{4})"); "[A-Z]{3}[0-9]{3}";SPALTE(D1))
Q23=EXTRACT(AG23;" [0-9]{4}[A-Z]{1,2}")


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

« Gruß Sepp »

Anzeige
AW: ändere den Code der UDF ...
11.01.2012 10:46:55
mehmet
Hallo Sepp,
klappt echt gut. Dank Dir. Nun wollte ich alles Darstellen, die nach den ersten Buchstaben Q+4stelligeZahl kommen. Ich habe versucht den Function umzustricken aber komme nicht weiter. Wie sähe es den aus?
Bsp:
LFPG 280130Z 19008KT 0300 R27L/1000V1500D R09R/1000VP2000D R26R/1400VP2000D R08L/1200D R26L/1000VP2000D R08R/0900V1500D R27R/1000V1700D R09L/0900N FG VV/// 03/03 Q1031 BECMG R08R/1500VP2500U
Also immer ab Buchstabe Q+4stelligeZahl (fett dargestellt)
Dann wollte ich noch andere Werte isolieren wie:
Zeige alles was mit:
Buchstabe R+2stelligeZahl und Zeichen / (Slash) oder
Buchstabe R+2stelligeZahl mit Buchstabe L oder
Buchstabe R+2stelligeZahl mit Buchstabe R oder
Buchstabe R+2stelligeZahl mit Buchstabe C beinhalten
bis erste Buchstabe Q+4stelligeZahl kommt
Hier ein Bsp:
LFPG 280130Z 19008KT 0300 R27L/1000V1500D R09R/1000VP2000D R26R/1400VP2000D R08L/1200D R26L/1000VP2000D R08R/0900V1500D R27R/1000V1700D R09L/0900N FG VV/// 03/03 Q1031 BECMG R08R/1500VP2500U
Das mit R08R/1500VP2500U nicht mehr da es nach Q+4stelligeZahl steht
Also nur die fett markierten.
Kurze frage noch, warum steht in der Formel der Verweis auf Zelle A1/B1/C1/D1
Müssen diese Zellen leer sein oder ist das einfach ein Platzhalter für etwas
M22 =EXTRACT(EXTRACT($AG$22;"^.*(?=Q[0-9]{4})"); "[A-Z]{3}[0-9]{3}";SPALTE(A1))
N22 =EXTRACT(EXTRACT($AG$22;"^.*(?=Q[0-9]{4})"); "[A-Z]{3}[0-9]{3}";SPALTE(B1))
O22 =EXTRACT(EXTRACT($AG$22;"^.*(?=Q[0-9]{4})"); "[A-Z]{3}[0-9]{3}";SPALTE(C1))
P22 =EXTRACT(EXTRACT($AG$22;"^.*(?=Q[0-9]{4})"); "[A-Z]{3}[0-9]{3}";SPALTE(D1))
Q23 =EXTRACT(AG23;" [0-9]{4}[A-Z]{1,2}")
Und wofür steht ^.* bzw. ?=
Dank Dir
Gruss
Mehmet
Anzeige
AW: ändere den Code der UDF ...
11.01.2012 11:00:44
Josef

Hallo Mehmet,
Spalte(A1) ist ein Platzhalter für 1, B1 für 2 usw.
Wäre es nicht einfacher, wenn du eine Beispieltabelle mit verschiedenen Inhalten hochlädst und in die Zellen einträgst, was du extrahieren willst (mit Beschreibung)

« Gruß Sepp »

mit Beispiel Datei
12.01.2012 01:36:23
mehmet
Hallo Sepp,
die Quellkodierung ist immer Spalte AG. Dorthin werden die Daten aus dem Internet reingeladen.
Die gelben Zelle sind die Daten von der Codierung, die noch nicht ganz einwandfrei funktionieren aus AG.
Ich habe diese aus dem Quellcode entnommen und dort eingetragen, in welche Spalte es kommen soll.
Zu den einzelnen Überschriften habe ich Kommentare eingetragen, wie die Codierungen sich von einander trennen.
Falls ich mich unverständlich ausgedruckt haben sollte bitte las es mich wissen
Ich Danke Dir

Die Datei https://www.herber.de/bbs/user/78375.xls wurde aus Datenschutzgründen gelöscht


AW: mit Beispiel Datei
12.01.2012 10:18:24
Josef

Hallo Mehmet,
mit Formeln wird das wohl nichts, bzw. zu unübersichtlich.
Anbei eine VBA-Lösung, schau mal, ob das so passt.
https://www.herber.de/bbs/user/78385.xls

« Gruß Sepp »

AW: mit Beispiel Datei
13.01.2012 02:14:25
mehmet
Hallo Sepp,
dank dir. Ich bin akribisch alles durchgegangen. Folgende Sachen habe ich markiert (siehe Anhang):

Die Datei https://www.herber.de/bbs/user/78412.xls wurde aus Datenschutzgründen gelöscht


Spalte R:
keine Ahnung warum aber da stimmen wille Zellen nicht. Irdendwo kommen die Werte her.
Alles was in Spalte R gehört/nicht gehört, habe ich markiert bzw. Alles was in Spalte R weiss ist, ist richtig.
Spalte S, T und U:
hier werden die Sachen eingetragen, die bereits nach Buchstabe Q+4stellige Zahl kommen.
Teilweise fehlen Sachen.
Spalte V, W, X und Y:
hier das gleiche. Teilweise Sachen, die nach Buchstabe Q+4stellige Zahl kommen.
Ferner habe ich nicht darauf geachtet, dir mitzuteilen, das die Werte NSC, CLR, SKC, NCD vorkommen können. Also nur diese 3Buchstaben ohne Werte.
Die Markierungen /// nach 3Buchstaben+3Zahlen können auch vorkommen.
Achso, wenn du natürlich den Makro laufen lässt, dann werden meine Einträge (gelbbraun) überschrieben.
Ich Danke Dir für deine Mühe.
Gruss
Mehmet
AW: mit Beispiel Datei
13.01.2012 18:27:26
Josef

Hallo Mehmet,
das gelb gefärbte Feld wird sich nicht ausschließen lassen, zumindest weiß ich nicht wie.
Bei den rot gefärbten Feldern müsstest du noch mal schauen, was dort rein soll, laut Vorgabe finde ich dort keine Übereinstimmung.
https://www.herber.de/bbs/user/78427.xls

« Gruß Sepp »

AW: mit Beispiel Datei
13.01.2012 20:05:22
mehmet
Hallo Sepp,
Dank Dir. Du bist super. Ich dachte schon, dass du mich vergessen hast. Ich habe den ganzen Tag ungeduldig gewartet. Ich habe es mir angeschaut. Funktioniert wunderbar.
Ja, du hast recht. Spalte S, T und U ist noch nicht ganz schlüssig. Darf ich dir ein Vorschlag unterbreiten. Könnte man die Spalte S, T und U seperat so verarbeiten lassen. Die Abfrage könnte ich mir so vorstellen.
Makro, wenn du in V-Spalte abfrage angekommen bist, dann gehe 1xLeer zurück und guck ob die Sachen von der Abfrage S, T und U Spalte vorhanden sind, wenn ja trage diese jeweils (falls vorhanden mit Vorzeichen) ein. Die Genze (rückwärtz Abfrage) sollte ein String mit mindestenz 2 Zahlen geben oder das Wort CAVOK alleine oder das Wort NDV in einem String.
Achso, wenn ich den Button klicke, bekomme eine Fehlermeldung "Laufzeitfehler 1004: Die Methode 'Calculation' für das Object'_Application ist fehlgeschlagen". Die Meldung verweist auf: .Calculation = lngCalc.
Ich Danke Dir
Gruss
Mehmet
AW: mit Beispiel Datei
13.01.2012 20:22:35
Josef

Hallo Mehmet,
die Fehlermeldung kommt, weil ich vergessen habe, bei diesem Block
On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  lngCalc = .Calculation
  .Calculation = xlCalculationManual
  .DisplayAlerts = False
End With

die ' zu entfernen, hatte ihn zum testen auskommentiert.
Das andere schau ich mir mal an.

« Gruß Sepp »

AW: mit Beispiel Datei
13.01.2012 22:25:16
Josef

Hallo Mehmet,
habe die Pattern noch einmal verfeinert, schau mal, was du meinst.

Die Datei https://www.herber.de/bbs/user/78431.xls wurde aus Datenschutzgründen gelöscht



« Gruß Sepp »

feinschliff
13.01.2012 23:08:06
mehmet
Hallo Sepp,
perfect. Dank Dir. Nur bei Wolken fehlen die /// (3mal slash falls vorhanden). Ich wollte diese anpassen aber habe im Macro gesehen, dass
...|NCD|VV){1}[0-9/]{0,3}(CB|TCU){0,1}")
bereits steht. Könntest du noch mal kurz gucken bitte.
Kurze Frage noch bitte, wird die Module mit "Extract_Formel_Sicht_VBA" benötigt?
Könntest Du bitte noch die Codierung soweit wie möglich kommentieren damit ich das nachvoll ziehen kann.
Also ich muss sagen, dass du wirklich ein VBA Experte bis.
Ich Danke Dir
Gruss
Mehmet
AW: feinschliff
13.01.2012 23:09:39
mehmet
sorry, Datei vergessen 8-)

Die Datei https://www.herber.de/bbs/user/78432.xls wurde aus Datenschutzgründen gelöscht


AW: feinschliff
13.01.2012 23:33:29
Josef

Hallo Mehmet,
das Modul wird benötigt (habe es umbenannt), dort ist die entscheidende Funktion enthalten.

Die Datei https://www.herber.de/bbs/user/78433.xls wurde aus Datenschutzgründen gelöscht



« Gruß Sepp »

AW: feinschliff
14.01.2012 01:12:04
mehmet
Hallo Sepp,
besten Dank. Es funktioniert echt gut. Natürlich ohne Fehlermeldung 8-)
Dafür habe ich jetzt eine Fehlermeldung.
Ich wollte ein CrossChecker einbauen.
Der sollte Zellen C6 bis AC6 zusammen führen und diese wieder mit AG6 vergleichen
ob die einzelne Elemente auch erfasst wurden. Diese Schleife sollte bis Zeile 113 gehen.
Wenn Unstimmigkeiten, dann sollte die Fundstelle (Zelle in Spalte AD) rot markiert werden und der User ein MsgBox erhalten wo diese Stelle ist.
Mein Makro will ab nicht.
Wie dem es auch sei.
Ich Danke dir ganz herzlich für deine Mühe und Geduld.
Gruss
Mehmet
https://www.herber.de/bbs/user/78437.xls
AW: feinschliff
14.01.2012 10:28:54
Josef

Hallo Mehmet,
probier mal.
' **********************************************************************
' Modul: CrossChecker Typ: Allgemeines Modul
' **********************************************************************

Option Explicit 'Variablendeklaration erforderlich!
'Diese Option sollte man immer setzen, geht automatisch über die Einstellung
'> Extras > Optionen > Editor > 'Variablendeklaration erforderlich'


'Linke und rechte Seite gegenüberstellen ob identisch zwecks Kontrolle
Sub CrossCheck()
  Dim rng As Range 'Variablendeklarationen gehören immer an den Beginn einer Prozedur
  'Lösche Bereich
  With Range("AD6:AF113") 'man barucht kein .Select
    .ClearFormats 'Fomate löschen
    .ClearContents 'Inhalt löschen
  End With
  'Linke Zellen zusammen führen
  Range("AD6:AD113").Formula = _
    "=C6&D6&E6&F6&G6&H6&I6&J6&K6&L6&M6&N6&O6&P6&Q6&R6&S6&T6&U6&V6&W6&X6&Y6&Z6&AA6&AB6&AC6"
  'Rechte Zelle einfügen - Leerzeichen entfernen
  Range("AF6:AF113").Formula = "=SUBSTITUTE(AG6,"" "","""")"
  'vergleichsformel
  Range("AE6:AE113").Formula = "=IF(AD6<>AF6,TRUE(),"""")"
  'Formel in Werte umwandeln
  Range("AD6:AF113") = Range("AD6:AF113").Value
  'Vergleiche Spalte AD und AF
  On Error Resume Next
  Set rng = Range("AE6:AE113").SpecialCells(xlCellTypeFormulas, xlLogical)
  On Error GoTo 0
  If Not rng Is Nothing Then rng.Interior.Color = vbRed
  Range("AD6:AF113").ClearContents
  Set rng = Nothing
End Sub



« Gruß Sepp »

AW: feinschliff
14.01.2012 11:20:37
mehmet
Hallo Sepp,
Makro läuft ohne Fehler. Ich hab mal ein künstlichen Fehler eingebaut. Die wurde aber vom Makro nicht erkannt. Ich glaube ab hier unten könnte der Fehler sein:
  'Vergleiche Spalte AD und AF
On Error Resume Next
Set rng = Range("AE6:AE113").SpecialCells(xlCellTypeFormulas, xlLogical)
On Error GoTo 0
If Not rng Is Nothing Then rng.Interior.Color = vbRed
Range("AD6:AF113").ClearContents
Set rng = Nothing
End Sub
Dank Dir
Gruss
Mehmet
AW: feinschliff
14.01.2012 11:27:12
Josef

Hallo Mehmet,
ändere xlCellTypeFormulas in xlCellTypeConstants, ich habe zuerst so getestet und vergessen es umzustellen.

« Gruß Sepp »

AW: feinschliff
14.01.2012 11:45:19
mehmet
Hallo Sepp,
super, es markiert die Fehler. Es sind die Fehler, wo die Formate falsch sind. Z.B. steht in Zelle der Wert 20, soll aber 020 sein. Ich habe diese dann in Benutzerdefiniert umformatiert Typ: 000. Der Makro übernimmt aber trotzdem 20 statt 020. Es handelt sich um Spalte D6:D113 soll 00 sein, E6:E113 soll 0000 sein, H6:H113 soll 000 sein, i6:i113 soll 00 sein, K6:K113 soll 00 sein, M6:M113 soll 000 sein, o6:o113 soll 000 sein, P6:P113 soll 0000 sein.
Dank Dir
Gruss
Mehmet
AW: feinschliff
14.01.2012 12:17:30
mehmet
Hallo Sepp,
sorry ich nochmal,
wie war das mit:
Trim(...)
da müssen noch die Leerzeichen weg zwecks Vergleich
Hab mal im Archive gesucht und bin nicht ganz fündig geworden.
Also Trim für Spalte AD6:AD113 und AF6:AF113
Gruss
Mehmet
AW: feinschliff
14.01.2012 14:01:08
Josef

Hallo Mehmet,
dazu würde ich diesen Code folgendermaßen ändern
'Dank an Herber
Sub Sort_Wind()
  Dim arr As Variant
  Dim iRow As Integer, iArr As Integer, iAdd As Integer, iChr As Integer
  Dim sTxt As String
  
  Worksheets("Target").Select
  Range("d6:ae80").ClearContents
  Range("D6:P80").NumberFormat = "@"
  
  For iRow = 6 To 80 'Spalte AE6 bis AE80
    
    If IsEmpty(Cells(iRow, 33)) Then Exit For 'Wenn Spalte 33, also AG Leer dann For-Schleife verlassen
    
    iAdd = 0
    sTxt = Cells(iRow, 33).Value '33 ist Spalte AG, also AG6 dann AG7...
    arr = Split(sTxt)
    
    Cells(iRow, 3).Value = Trim$(arr(0)) '3 ist Spalte C wo ICAO kommt
    Cells(iRow, 4).Value = Trim$(Format(Clng(Mid(arr(1), 1, 2)), "00")) '4 ist Spalte D wo dd kommt
    Cells(iRow, 5).Value = Trim$(Format(Clng(Mid(arr(1), 3, 4)), "0000")) '5 ist Spalte E wo hhhh kommt
    Cells(iRow, 6).Value = Trim$(Mid(arr(1), 7, 1)) '6 ist Splate F wo Z kommt
    
    If arr(2) Like "*#*" = False Then 'Wenn 3'te Array AUTO ...
      Cells(iRow, 7).Value = Trim$(arr(2)) '7 ist Spalte G wo AUTO kommt
      iAdd = iAdd + 1
    End If
    
    Cells(iRow, 8).Value = Trim$(Format(Mid(arr(2 + iAdd), 1, 3), "000")) '8 ist Spalte H wo Grad kommt
    Cells(iRow, 11).Value = Mid(arr(2 + iAdd), 4, 2) '11 ist Spalte K wo KTzahl kommt
    
    If InStr(arr(2 + iAdd), "G") Then
      Cells(iRow, 10).Value = "G" '10 ist Spalte J wo Buchstabe G kommt
      Cells(iRow, 9).Value = Trim$(Format(Mid(arr(2 + iAdd), 4, 2), "00")) '9 ist Spalte i wo KTzahl kommt
      Cells(iRow, 11).Value = Trim$(Format(Mid(arr(2 + iAdd), 7, 2), "00")) '11 ist spalte K wo KTzahl kommt
    Else
      Cells(iRow, 11).Value = Trim$(Mid(arr(2 + iAdd), 4, 2))
      Cells(iRow, 12).Value = Trim$(Right(arr(2 + iAdd), Len(arr(2 + iAdd)) - 5)) '12 ist Spalte L wo KTbuchstaben kommt
    End If
    
    For iChr = Len(arr(2 + iAdd)) To 4 Step -1
      If IsNumeric(Mid(arr(2 + iAdd), iChr, 1)) Then Exit For
    Next iChr
    
    Cells(iRow, 12).Value = Trim$(Right(arr(2 + iAdd), Len(arr(2 + iAdd)) - iChr))
    
    If arr(3 + iAdd) Like "*#V#*" Then
      Cells(iRow, 13).Value = Trim$(Format(Left(arr(3 + iAdd), InStr(arr(3 + iAdd), "V") - 1), "000"))
      Cells(iRow, 14).Value = "V"
      Cells(iRow, 15).Value = Trim$(Format(Right(arr(3 + iAdd), Len(arr(3 + iAdd)) - InStr(arr(3 + iAdd), "V")), "000"))
      Cells(iRow, 16).Value = Trim$(Format(arr(4 + iAdd), "0000"))
    ElseIf arr(3 + iAdd) Like "####" Or arr(3 + iAdd) = "CAVOK" Then
      Cells(iRow, 16).Value = Trim$(Format(arr(3 + iAdd), "0000"))
    End If
    
    'Begin Zusatz von mir
    If arr(4) Like "####[SNEW]" Then
      Cells(iRow, 17).Value = Trim$(arr(4))
      iAdd = iAdd + 1
    End If
    'Ende Zusatz
    
  Next iRow
  
End Sub


und den hier so
Sub CrossCheck()
  Dim rng As Range 'Variablendeklarationen gehören immer an den Beginn einer Prozedur
  'Lösche Bereich
  With Range("AD6:AF113") 'man barucht kein .Select
    .ClearFormats 'Fomate löschen
    .ClearContents 'Inhalt löschen
  End With
  'Linke Zellen zusammen führen
  Range("AD6:AD113").Formula = _
    "=SUBSTITUTE(C6&D6&E6&F6&G6&H6&I6&J6&K6&L6&M6&N6&O6&P6&Q6&R6&S6&T6&U6&V6&W6&X6&Y6&Z6&AA6&AB6&AC6,"" "","""")"
  'Rechte Zelle einfügen - Leerzeichen entfernen
  Range("AF6:AF113").Formula = "=SUBSTITUTE(AG6,"" "","""")"
  'vergleichsformel
  Range("AE6:AE113").Formula = "=IF(AD6<>AF6,TRUE(),"""")"
  'Formel in Werte umwandeln
  Range("AD6:AF113") = Range("AD6:AF113").Value
  'Vergleiche Spalte AD und AF
  On Error Resume Next
  Set rng = Range("AE6:AE113").SpecialCells(xlCellTypeConstants, xlLogical)
  On Error GoTo 0
  If Not rng Is Nothing Then rng.Interior.Color = vbRed
  'Range("AD6:AF113").ClearContents
  Set rng = Nothing
End Sub


Dan werden die Werte gleich richtig formatiert und ohne zusätzliche Leerzeichen eingetragen
und bei der Überprüfung werden Leerzeichen die zwischen Weten stehen auch eliminiert.

« Gruß Sepp »

der Ultimative Stresstest 8-)
14.01.2012 16:40:43
mehmet
Hallo Sepp,
läuft prima, funktioniert ohne Fehlermeldung und alle Sachen werden ohne Fehler angezeigt.
Beim Stresstest (absolut Härtefälle) ist es nicht so ganz erfolgreich.
Fehler zeigt es an, weil Spalte P und Spalte Q die Werte gleich zeigen.
Vermutlich überschneidet das Makro von Herrn Herber mit deinem Makro.
Die Spalte P sollte so aufgebaut sein:
4stellige Zahl oder das Wort CAVOK.
Spalte Q sollte beinhalten (falls Werte vorhanden):
4stellige Zahl + Wort NDV (Bsp: 1000NDV, kann auch 1000/NDV sein) oder
4stellige Zahl + Himmelsrichtung (Bsp.: 1000SE oder 2500NW oder 4500N).
Wenn du möchtest kannst du den Stresstest mal durchführen lassen.
Dazu dann nur Makro "Sort_Wind", dann "Tabelle2.Uebertrag" dann "CrossCheck".
https://www.herber.de/bbs/user/78441.xls
Ich kann dir gar nicht sagen wie Dankbar ich bin, dass es überhaupt so weit kommen konnte.
Ich möchte mich nochmal ganz herzlich bedanken.
Gruss
Mehmet

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige