Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Tabelle transponieren & zusätzliche Infos auslesen


Betrifft: Tabelle transponieren & zusätzliche Infos auslesen von: Jens
Geschrieben am: 11.07.2017 13:29:29

Hallo zusammen,

ich muss hier eine super schwere vba Aufgabe lösen und bin mittlerweile am verzweifeln. Meine Kenntnisse sind einfach nicht ausreichend um das hin zu bekommen. An einigen Teilaspekten habe ich mich versucht, scheitere aber schon bei den eher einfachen Sachen. Die schwierigen Fragen weiss ich noch gar nicht ob die sich lösen lassen.

Im Anhang ist die Aufgabe im zweiten Reiter kurz beschrieben. Schon das zuverlässige Eingrenzen der einzeln zu bearbeitenden Blöcke, und diese dann Stück für Stück auszulesen hat mich an meine Grenzen gebracht. Hier allerdings ein guter Link der im Prinzip glaube ich gut ist, um diesen Teilaspekt der Aufgabe zu lösen:

https://stackoverflow.com/questions/22075988/detect-merged-cells-in-vba-excel-with-mergearea

Dann habe ich noch sehr lange gegooglt um herauszufinden, ob es in vba eine Funktion gibt um ein im Schriftsatz (Font) fehlendes Zeichen (Fragezeichen in einem Kästchen wird dann angezeigt) zu erkennen? Das mit =SÄUBERN() [=CLEAN()] hat bei mir nicht funktioniert. Warum weiss ich nicht. Ich habe zwei Links gefunden die etwas sein könnten, aber mit denen kann ich nichts anfangen.

https://social.technet.microsoft.com/Forums/ie/en-US/a15bd2b9-a023-4473-b1a0-7afeb261bee7/question-mark-in-a-box-for-some-not-for-others?forum=excel

https://stackoverflow.com/questions/3488242/microsoft-word-change-font-of-characters-missing-in-default-font

Schafft es irgend jemand das zu lösen?

Hier der Anhang: https://www.herber.de/bbs/user/114808.xlsx

  

Betrifft: AW: Nett, aber ... von: Fennek
Geschrieben am: 11.07.2017 14:50:40

Hallo,

nach ein paar Tests war es relativ einfach, die MergedCellAreas und die Unicode (AscW()) auszulesen.

Die Unterscheidung, ob das Zeichen dargestellt wird, oder nur ein ? sichtbar ist, ist mir nicht gelungen.

mfg


  

Betrifft: AW: Nett, aber ... von: Jens
Geschrieben am: 11.07.2017 16:07:10

Hallo Fennek,

vielen Dank für die Antowt. Wenn man nicht klären kann, ob ein richtiges Zeichen oder nur ein Platzhalter (Fragezeichen im Kästchen oder Bockkästchen) dargestellt wird, muss ich noch mal darüber nachdenken, wie ich mit vielleicht anderen oder geringeren Anforderungen an das Ziel komme.

Da muss ich jetzt erst noch mal Nachdenken.

Vielen Dank
Jens


  

Betrifft: Das ist etwas arbeitsaufwendig, ... von: Luc:-?
Geschrieben am: 11.07.2017 15:10:37

…Jens,
wozu ich eigentlich weder Zeit noch Lust habe, zumal das keine xl-typische Aufgabe ist. Nur mal soviel:
1. Das BlockEingrenzen sollte kein Problem sein, da man ja nur die Zellen in Spalte B auf VerbundZellen­Zugehörigkeit prüfen müsste:
If Sheets("0000–0FFF").Cells(x, 2).MergeCells Then z(n) = x
(x als LaufVariable einer Schleife über die Zeilen, n als Index von z)
Ein Block reichte dann von .Cells(z(v) + 1, 2) bis .Cells(z(v + 1) - 1, 18) für vє[0,2,…].
2. Bei den YES/NO-ZusatzInfos wird's schwierig, denn womit soll man da vgln‽ SÄUBERN fktioniert in diesen Bereichen offensichtlich nicht, falls es sich um zulässige Zeichen handelt oder handeln könnte. Hinter jedem steht ein anderes Zeichen und einige davon sind wohl diakritisch, also womöglich keine mehr bei richtiger Anwendung und Interaktion mit Buchstaben. Dieser Teil der neuen Tab dürfte also kaum in Gänze maschinell erstellbar sein!
Damit ist diese Aufgabe nicht nur megaschwer, sondern mE auch mega-idiotisch! Die allerneuesten Unicode-Erweiterungen (auf 5 Stellen) lassen sich ohnehin nicht mit VBA handhaben. Dessen entsprd Fktt ChrW und AscW decken ohnehin wohl nur alles bis UC 9.0 ab. Xl-Fonts und HTML können da schon weiter sein, wie man unten sehen kann.
🙈 🙉 🙊 🐵 Gruß, Luc :-?

Besser informiert mit …


  

Betrifft: AW: Das ist etwas arbeitsaufwendig, ... von: Jens
Geschrieben am: 11.07.2017 21:14:41

Hallo Luc,

vielen Dank für deine Antwort. Das war ein großer Schritt in die richtige Richtung. Das Konzept des Macros denke ich steht. Und auch wenn es nicht möglich ist die [?] zu erkennen so könnte ich vielleicht mit einem Teilergebnis schon mal etwas anfangen. Das [?] Problem verschiebe ich erst mal. Irgenwo hatte ich jetzt aber noch gelsen, dass ich - wenn es sich um die genaue reproduktion des Zellinhaltes (der einzelnen Character handelt - ich vielleich besser mit Dictionary arbeite als mit arrays. Jetzt dachte ich daher probiere ich besser mal beiders.

Leider ist der Code den ich bis jetzt zusammen geschrieben habe nicht lauffähig. Ich bekommen ein Error:

Ungültiger Prozeduraufruf oder ungültiges Argument für die Zeile:

Set Matrizen = Union(Matrizen, .Range(Cells(z(i) + 1, 2).Address & ":" & Cells(z(i + 1) - 1, 18).Address))
Kannst du mir hier weiterhelfen? Hier der ganze code:

Option Explicit
    
Sub FindGrayCells_2()

    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim Ws As Worksheet: Set Ws = Wb.ActiveSheet
    'Dim chkrng As Range
    Dim Matrizen As Range
    Dim Dic As Object ',RegEx As Object
    Dim z(), ZellInfos(), a
    Dim x&, i&, j&, n&, m&, o&, spalte&, zeile&
    Dim KontrollNachricht As String
    
    n = 0
    m = 0
    o = 0
    
    Application.ScreenUpdating = False
    Set Dic = CreateObject("Scripting.Dictionary")
    'Set RegEx = CreateObject("vbscript.regexp")
    
    With Ws
        For x = 1 To 1000
            If .Cells(x, 2).MergeArea.Columns.Count = 17 Then
                n = n + 1
                ReDim Preserve z(n)
                z(n) = x
            End If
        Next x

        For i = 1 To n
            Set Matrizen = Union(Matrizen, .Range(Cells(z(i) + 1, 2).Address & ":" & Cells(z(i + _
 1) - 1, 18).Address))
        Next i
        
        For i = 1 To Matrizen.Areas.Count
            a = Matrizen.Areas(i)
            For zeile = LBound(a, 1) To UBound(a, 1)
                    o = o + 1
                For spalte = LBound(a, 2) To UBound(a, 2)
                    m = m + 1
                    ReDim Preserve ZellInfos(m, 6)
                    
                    'Zellwert1
                    Dic.Add a(zeile + 1, spalte + 1), ""
                    'Zellenblockname
                    ZellInfos(m, 1) = a(-1, 2).Value
                    'ZeilenName
                    ZellInfos(m, 2) = a(zeile + 1, 1).Value
                    'Spaltenname
                    ZellInfos(m, 3) = a(zeile, spalte + 1).Value
                    'Zellwert2
                    ZellInfos(m, 4) = a(zeile + 1, spalte + 1).Value
                    'ZellenHintergrundfarbe
                    ZellInfos(m, 5) = a(zeile + 1, spalte + 1).bgcolor
                    'Enthält Zelle beide eckige Klammern?
                    '???
                    
                    
                    For j = 1 To 6
                        KontrollNachricht = KontrollNachricht & ZellInfos(m, j) & vbNewLine
                    Next j
                    MsgBox "Hier die Kontrollausgabe:" & vbNewLine & KontrollNachricht
                Next spalte
            Next zeile
        Next i
    End With
    
    'Gehe zum Sheet(NEU) und füge die Daten in die gewünschte Zelle hinzu
        
    Erase z: Erase ZellInfos
        
Allcellsareempty:
    Set Wb = Nothing
    Set Ws = Nothing
'    Set chkrng = Nothing
    Set Dic = Nothing
'    Set RegEx = Nothing
    
    Application.ScreenUpdating = True


End Sub



  

Betrifft: Neue Frage ?? von: Jens
Geschrieben am: 11.07.2017 21:57:46

Oder soll ich noch mal neu posten da die eigentliche Frage jetzt eine andere geworden ist?


  

Betrifft: Nee, nicht erforderlich, gehört ja noch z.Thema, … von: Luc:-?
Geschrieben am: 11.07.2017 23:12:00

…Jens;
nur erst mal soviel: Hast offensichtlich 'ne Menge bedacht und beachtet. Alles weitere wird sich dann auch finden. Wenn ich's schaffe, sehe ich's mir morgen gründlicher an.
Luc :-?


  

Betrifft: Danke! Freue mich auf deine Rückmeldung von: Jens
Geschrieben am: 12.07.2017 07:29:37

Super! DANKE! Freue mich auf deine Rückmeldung.


  

Betrifft: Neuer Anlauf von: Jens
Geschrieben am: 13.07.2017 09:16:22

Hallo Luc,

ich werde jetzt noch mal einen Versuch starten an den Stellen wo ich bis jetzt gescheitert bin, irgendwie vorwärts zu kommen. Vielen Dank für deine Hilfe soweit. Sollte ich noch mal stranden mir irgend einem bisher hier nicht diskutierten Thema, dann würde ich doch ein neues Thema eröffnen, da ich das Gefühl habe hier schaut niemand mehr drauf.

Vielen Dank für deine Hilfe.

Viele Grüße
Jens


  

Betrifft: Doch, doch, ich, aber dauert noch, weil ... von: Luc:-?
Geschrieben am: 13.07.2017 18:59:42

…zZ etwas unpassend, Jens,
da zeitaufwendig. Und ob ein neuer Thread mehr Begeisterung weckt, ist bei dem Gegenstand ziemlich fraglich…
Luc :-?


  

Betrifft: Nebenbei, sehe keine Chance für ZusatzInfos ... von: Luc:-?
Geschrieben am: 14.07.2017 03:41:42

…per Pgm, Jens,
zumindest nicht die boxed q-marks und small boxes, obwohl für erstere in der headline das neutrale Symbol (wohl aus dem erweiterten UniCode-Satz ab 10000h) benutzt wurde (das wird bei Auswertung per vbFkt AscW negativ). In den konkreten Fällen wird aber nicht dieser, sondern ganz normal der Positionswert angezeigt. Bei dem anderen Symbol ist es fast noch hoffnungsloser, so dass diese Abschnitte allerhöchstens fest vorgegeben wdn könnten, was natürlich nicht auto-aktualisierend wäre.
Mit deinem Pgm befasse ich mich am WE.
Morrn, Luc :-?


  

Betrifft: Ich hab noch was gefunden, aber ... von: Jens
Geschrieben am: 14.07.2017 22:38:41

Hallo Luc,

vielen Dank für deine andauernde Hilfe. Ich glaube ich habe jetzt in 2 schweren Tagen Stufe 1 fast selber erreicht. Ich muss noch mal 2-3 logische Bugs eleminieren weil nach mehreren Zeilen plötzlich an falscher Stelle weiter gearbeitet wird und ähnliches bei der Ausgabe passiert. Aber das sind Probleme die ich hoffentlich lösen kann. Wenn jetzt nicht noch irgendwas hochkommt, wo ich wieder wie der Ochs vor dem Berg stehe dann fehlt mir nur noch eine Iteration durch alle Sheets (außer dem was 'NEU' heißt oder neu angelegt wird.) Ich hoffe das bekomme ich auch hin.

Wo du mir im Moment jetzt noch am meisten helfen könntest, wäre wenn du dir mal diesen Code den ich gefunden habe anschauen kannst:

https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-msoffice_custom/check-if-a-unicode-character-is-available-in-the/492757a5-b965-4f91-b340-855725cd8307

A) Ich habe ihn ausprobiert und zumindest läuft er. Aber bei mir zeigt er nicht immer das richige Ergebnis. Bei mir werden Zeichen richtig dargestellt bei denen der Code ausgibt, dass diese Zeichen nicht unterstützt werden (dann können sie nach meiner Meinung auch nicht richitg dargestellt werden). Oder aber es wird eigenltich etwas ganz anderes geprüft (?) (z.B. ANSI-Zeichensatz Zugehörigkeit und nicht Schriftsatz Zugehörigkeit)? Kannst du erahnen/erkennen ob der Code falsch läuft oder vielleicht mit einer anderen Zielsetzung geschrieben wurde als ich es benötige? (Übrigens: Für mein VBA Niveau ist der Code so komplex, da bin ich komplett draußen :-( )

B) Die ultimative Fage wäre dann für mich, kann der Code so angepasst werden, das ich den als Funktionsaufruf in meinen Code einbauen kann? In dem Sinne

Funktion IstZeichenInSchriftartEnthalten (Zeichen As ??, Schriftart as ??) as boolean
...
End Function

Sub Main()
Dim Zeichen as ??String
Dim Schriftart as ??
Dim Enthalten as boolean
Zeichen = .... Cells(x,y)
Schriftart = ???
Enthalten = IstZeichenInSchriftartEnthalten(Zeichen,Schriftart)
...
End Sub

Für die Sprache VB.Net habe ich hier etwas ähnliches auch im Netz gefunden. Allerdings verstehe ich davon auch nichts. Vielleicht kannst du da aber auch noch was raus lesen. Quelle (der Code wird weiter unten im Thread nochmal an zwei Stellen optimiert!!):

https://stackoverflow.com/questions/103725/is-there-a-way-to-programmatically-determine-if-a-font-file-has-a-specific-unico

Wäre super cool wenn wir das doch noch irgendwie hin bekommen.

Vielen Dank für deine Hilfe.

Viele Grüße
Jens


  

Betrifft: Nebenbei, Folgendes könnte dich auch ... von: Luc:-?
Geschrieben am: 15.07.2017 20:26:46

…interessieren, Jens,
zumal dort etliche Links enthalten sind:
http://www.office-loesung.de/p/viewtopic.php?f=166&t=739549&sid=c6bd67f2848f47f9e314bffc064d679e
Luc :-?


  

Betrifft: So, jetzt mal zurück zum HptPgm, ... von: Luc:-?
Geschrieben am: 16.07.2017 19:40:35

…Jens;
dessen 1.Teil würde mit folgendem Code laufen:

Sub FindGrayCells_2()
    Const adGesBerSp1$ = "B31:B357"
    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim Ws As Worksheet: Set Ws = Wb.ActiveSheet
'    Dim chkrng As Range
    Dim a As Range, Matrizen As Range, xZ As Range
    Dim Dic As Object ',RegEx As Object
    Dim ZellInfos()
    Dim i&, j&, n&, m&, o&, spalte&, z&(), zeile&
    Dim KontrollNachricht$
    Application.ScreenUpdating = False
    Set Dic = CreateObject("Scripting.Dictionary")
'    Set RegEx = CreateObject("vbscript.regexp")
    With Ws
        For Each xZ In .Range(adGesBerSp1)
            If xZ.MergeCells Then
                ReDim Preserve z(n)
                z(n) = xZ.Row
                n = n + 1
            End If
        Next xZ
        Set Matrizen = .Range(.Cells(z(0) + 1, 2), .Cells(z(1) - 1, 18))
        For i = LBound(z) + 1 To UBound(z) - 1
            Set Matrizen = Union(Matrizen, .Range(.Cells(z(i) + 1, 2), _
                                                  .Cells(z(i + 1) - 1, 18)))
        Next i
        With .Range(adGesBerSp1)
            Set Matrizen = Union(Matrizen, Ws.Range(Ws.Cells(z(i) + 1, 2), _
                                           Ws.Cells(.Cells(.Rows.Count).Row, 18)))
            'alternativ:
'            Set Matrizen = Union(Matrizen, Ws.Range(Ws.Cells(z(i) + 1, 2), _
                                            Ws.Range(Split(adGesBerSp1, ":")(1))))
       End With
    End With
    '…
End Sub
Ich bin dabei iW dem Duktus deines Originals gefolgt, habe etwas ergänzt und korrigiert, was nicht fktionieren konnte. So kann man keine Union von Range-Objekten mit Nothing bilden. In With-Konstrukten sollten die erforderlichen Pktt nicht vergessen wdn, weiterhin ist zu beachten, dass reine VBA-Arrays (nicht die aus Fmln u.Bereichen) idR 0-basiert sind und, im Hinblick auf den 2.Teil, man kann bei mehrdimensionalen Arrays immer nur die letzte Dimension ReDimmen!
Aber diesen Teil sehe ich mir unter RationalisierungsAspekt noch mal an, weshalb ich ihn jetzt und hier noch nicht korrigiere. Zum Laufen habe ich die 1.Korrektur aber schon gebracht. Letztlich willst/kannst/musst du ja die Datenzeilen der neuen Tabelle schon im Array anlegen…
Evtl mache ich das dann gebrauchsfertig, aber nicht inkl der speziellen Wünsche, die mE einen hohen PgmmierAufwand verur­sa­chen (können → s.a. unter den vielen Links), weshalb ich nicht verstehen kann, warum gerade so etwas Bestandteil einer ansons­ten relativ einfachen VBA-Aufgabe ist. Viell ist das dem Dozenten selbst nicht klar…
Bis dann, Luc :-?


  

Betrifft: AW: So, jetzt mal zurück zum HptPgm, ... von: Jens
Geschrieben am: 16.07.2017 22:09:55

Hallo Luc,

vielen herzlichen Dank. Den Rest dieses Teils bekommen ich hin.

Warum das mit den Fragezeichen im Kästchen und den Rechtecken so wichtig ist, kommt daher, das es mittlerweile über 150.000 Unicode Zeichen gibt und ich diese nicht alle manuell durchgehen möchte, um zu markieren welche von der Schriftart nicht richtig dargestellt werden. Im weiteren Verlauf meiner Arbeit kann es sogar dazu kommen, dass ich diese Auswertung für mehrere (oder alle auf meinem Rechner) Schriften erstellen muss. Da wäre ich einfach zu lange manuell mit beschäftigt und daher die dringende Suche nach einer technischen Lösung.

Sollte von deiner Seite hierzu nichts mehr kommen, dann würde ich mit Verlaub diesen Teil der Frage noch mal neu posten. OK?

Vielen, vielen Dank für deine Hilfe!

Grüße
Jens


Beiträge aus den Excel-Beispielen zum Thema "Tabelle transponieren & zusätzliche Infos auslesen"