Microsoft Excel

Herbers Excel/VBA-Archiv

Feld-Format "Zahl" suchen und ausgeben lassen

Betrifft: Feld-Format "Zahl" suchen und ausgeben lassen von: Sparrow
Geschrieben am: 25.09.2014 14:52:04

Hallo liebe Leser,
ich suche unbedingt ein VBA Makro welches in einer Zeile bestimmte Spalten(durch einen Text definiert) findet, in denen ein Feld als Zahl formatiert ist. Dieses Feld soll dann auf einem neuen Tabellenblatt ausgegeben werden. Ich muss sagen dass ich absolut keine Ahnung habe wie ich anfangen soll, ich bitte um Hilfe!
Vielen Dank im Voraus!
Beste Grüße

Sascha

  

Betrifft: und warum muss es VBA sein ? ... von: neopa C (paneo)
Geschrieben am: 25.09.2014 15:00:17

Hallo Sascha,

... wenn es möglicherweise auch ohne geht? So wie Du es bisher beschrieben hast könnte es auch ohne VBA gehen. Allerdings solltest Du etwas konkreter werden. Was genau meinst Du mit: "...bestimmte Spalten(durch einen Text definiert)..."

Gruß Werner
.. , - ...


  

Betrifft: AW: und warum muss es VBA sein ? ... von: Sparrow
Geschrieben am: 25.09.2014 15:34:08

Ich suche aus Spalte B alle Werte die als Zahl formatiert sind und aus allen Spalten in Zeile 6 wo steht: X oder Y oder Z ebenfalls alle Werte die als Zahl formatiert sind. Abschließend sollen diese als Information mit Tabellenblatt-Name und Adresse in ein neues Tabellenblatt niedergeschrieben werden.

Ich weiß, etwas kompliziert - schonmal vielen Dank für die schnelle Antwort!

Beste Grüße

Sascha


  

Betrifft: noch immer nicht eindeutig ... von: neopa C (paneo)
Geschrieben am: 25.09.2014 15:44:04

Hallo Sascha,

... zunächst: Zahlenwerten in Spalte B, die standarformatiert sind sollen also nicht gelistet werden?
Und Deine Aussage "... aus allen Spalten in Zeile 6 wo steht: X oder Y oder Z ebenfalls alle Werte die als Zahl formatiert sind" ist widersprüchlich.

Gruß Werner
.. , - ...


  

Betrifft: AW: und warum muss es VBA sein ? ... von: Klaus M.vdT.
Geschrieben am: 25.09.2014 15:45:26

Hallo Sascha,

wird nur ein Miniscript. Aber bitte liefere erst eine Musterdatei, in der deine Zeilen/Spaltenvorgaben exakt eingehalten sind. Am besten mit 2-3 Zahlenformaten und 2-3 NichtZahlen und einer (händisch hingeschriebenen) Musterlösung zum Vergleich.

Grüße,
Klaus M.vdT.


  

Betrifft: AW: und warum muss es VBA sein ? ... von: Sparrow
Geschrieben am: 25.09.2014 15:57:39

Nochmals Danke für die Antwort, hier eine Musterdatei: https://www.herber.de/bbs/user/92818.xlsx

Die Zahlen gehen noch endlos weiter nach unten, das Problem bei X, Z, G und H ist, dass sich diese nicht immer in diesen Spalten befinden! Ich muss dementsprechend nach den X,Z,G und H suchen und nicht nach den Spalten.
Wie nun schon geschrieben will ich Spalte B (Diese ist Fest) nach Werten durchsuchen die als Zahl formatiert und ich suche nach den Spalten wo X, Z, G und H als Überschrift erscheinen - und in diesen Spalten suche ich dann wieder die Werte, die als Zahlen formatiert sind. Zuletzt will ich auf einem neuen Tabellenblatt die Adressen dieser Werte sowie den Tabellenblatt-Namen ausgegeben haben.

Ich hoffe es ist so verständlich.. sorry für diese laienhafte Ausdrucksart!

Nochmals vielen Dank!

Beste Grüße
Sascha


  

Betrifft: AW: und warum muss es VBA sein ? ... von: Klaus M.vdT.
Geschrieben am: 25.09.2014 16:18:03

Hallo Sascha,

ich hab nur Bahnhof verstanden. Kopier mal alles was unten steht in deine Datei und führe
FuereDiesesMakroAusNichtDasAndere
aus. Ich habe absolut keine Idee, wofür deine Spalte B gut sein soll.

Sub FuereDiesesMakroAusNichtDasAndere()
'gehe das Makro am besten mit F8 im Einzelschritt durch
Call AlleZahlenAusSpalte("X")
Call AlleZahlenAusSpalte("Z")
Call AlleZahlenAusSpalte("G")
Call AlleZahlenAusSpalte("H")
End Sub

Sub AlleZahlenAusSpalte(SpalteName1 As String)
Const ZeileHeadlines As Long = 6 'in Zeile 6 stehen die Überschriften
Const ZeileAb As Long = 8        'ab Zeile 8 nach Werten suchen
Const SheetZiel As String = "Tabelle2" 'Hierhin erfolgt die Ausgabe
Const SpalteZiel As Long = 1           'Ausgabe in Spalte 1

Dim SpalteIST1 As Long
Dim ZeileLetzteQuelle As Long
Dim ZeileLetzteZiel As Long
Dim r As Range

With ActiveSheet
    'die Spalte finden, die "X" als Überschrift hat
    SpalteIST1 = WorksheetFunction.Match(SpalteName1, .Rows(ZeileHeadlines), False)
    Debug.Print "Suche in Spalte " & SpalteIST1
    
    'und die letzte Zeile finden
    ZeileLetzteQuelle = .Cells(.Rows.Count, SpalteIST1).End(xlUp).Row
    Debug.Print "Gehe bis Zeile " & ZeileLetzteQuelle
    
    'NUR ZUM TESTEN: selektiere den Suchbereich. Die Zeile kannst du später löschen
    .Range(.Cells(ZeileAb, SpalteIST1), .Cells(ZeileLetzteQuelle, SpalteIST1)).Select
    
    'alle Zellen dieser Spalte durchgehen
    For Each r In .Range(.Cells(ZeileAb, SpalteIST1), .Cells(ZeileLetzteQuelle, SpalteIST1))
        If Not IsNumeric(r) Or Left(r.Value, 1) = "'" Then 'wenn keine Zahl in der Zelle steht  _
oder sie mit Hochkomma anfängt
            'dann tue nix
            Debug.Print "In " & r.Address & " steht kein Zahlenwert!"
        Else 'ansonsten, wenn eine Zahl in der Zelle steht:
            'schreibe die Zahl in die Zieltabelle unter die anderen Zahlen, und rechts daneben  _
die Überschrift
            Debug.Print r.Address & " überführen, die Zahl lautet " & r.Value
            With Sheets(SheetZiel)
                ZeileLetzteZiel = .Cells(.Rows.Count, SpalteZiel).End(xlUp).Row + 1
                .Cells(ZeileLetzteZiel, SpalteZiel).Value = r.Value
                .Cells(ZeileLetzteZiel, SpalteZiel).Offset(0, 1).Value = SpalteName1
                Debug.Print "im Ziel unter Zeile " & ZeileLetzteZiel & " den Zahlenwert " & r. _
Value; " aus Überschrift " & SpalteName1 & " einfügen"
            End With
        End If
    Next r
    
End With
End Sub
Grüße,
Klaus M.vdT.


  

Betrifft: AW: und warum muss es VBA sein ? ... von: Sparrow
Geschrieben am: 25.09.2014 16:43:03

Uh, der Hammer!
Also, es kommt schon sehr nahe an das heran was ich will!
Spalte B verhält sich so wie der Rest, der Unterschied ist nur dass diese Fix ist und immer analysiert werden soll, während die anderen Spalten erst mal gesucht werden müssen (in denen sich x,y etc als Überschrift befindet)

Ansonsten brauche ich auf Tabelle2 nicht die Überschrift der Spalte sondern lediglich den Tabellenblattnamen sowie die Adresse des Feldes (bspw. B5)

Nochmals vielen Dank, der absolute Hammer! Wäre top wenn du mir mit diesen Bedingungen nochmal helfen könntest!


Der Sinn dieses Makros soll übrigens folgendes darstellen: "Habe ich in dieser Tabelle Werte die als Zahl formatiert sind? Falls ja, wo sind diese (Auf welchem Tabellenblatt sowie in welcher Zelle?) damit ich den Fehler beheben kann?"
Beste Grüße
Sascha


  

Betrifft: gelöst, oder? von: Klaus M.vdT.
Geschrieben am: 29.09.2014 07:56:21

Hallo Sascha,
ich war übers verlängerte Wochenende spontan weg :-)
dir wurde im anderen Beitrag Zweig bereits geholfen, oder? Dann muss ich hier ja nicht weiter entwickeln.

Viele Grüße,
Klaus M.vdT.


  

Betrifft: Verwirrend von: Erich G.
Geschrieben am: 25.09.2014 18:47:50

Hi zusammen,
in diesem Thread verstehe ich so manches nicht. :-(

Am ehesten kapiere ich noch den Startbeitrag - wenn ich "Feld" durch "Zelle" ersetze, also
"bestimmte Spalten(durch einen Text definiert) findet, in denen eine Zelle als Zahl formatiert ist".

Fraglich ist aber, ob das auch wirklich das Gewollte ist.

Eine Zelle hat viele Eigenschaften. Schriftart, Hintergrundfarbe, Formel, Wert, Zahlenformat sind nur einige davon.
Nicht der Wert hat ein Zahlenformat - es ist die Zelle!

Eine Zelle kann das Zahlenformat #.##0,00 haben und gleichzeitig als Wert den Text "abc".
Eine Zelle kann das Textformat (@) haben, gleichzeitig kann die Zahl 4711 als Wert in der Zelle stehen.
Das hat zunächst mal nichts miteinander zu tun.
Ob eine Zahl oder ein Text in einer Zelle X2 steht, kann man manchmal optisch überhaupt nicht unterscheiden.
Man bekommt das aber verlässlich heraus mit den Excelfkt.
=ISTTEXT(X2)
=ISTZAHL(X2)

Natürlich gibt es einige Zusammenhänge, zum Beispiel:
Wenn eine Zahl in einer Zelle mit einem Zahlenformat steht, wird die Zahl dem Zahlenformat entsprechend angezeigt.
Das ist der Sinn des Zahlenformats.

Wenn eine Zahl das Textformat hat und es werden die Ziffern 123 in die Zelle eingegeben, wird in der Zelle
der Text "123" als Wert gespeichert, nicht jedoch die Zahl 123.

@Klaus:
Die VBA-Fkt. IsNumeric(r) prüft nicht, ob eine Zahl in der Zelle r steht. Sie prüft nur, ob in r ein Ausdruck steht,
der in eine Zahl konvertiert werden kann.

An Sascha nun die Frage:
Sollen alle Zellen aufgelistet werden, in denen die Werte Zahlen sind?
Oder sollen alle Zellen identifiziert werden, die ein Zahlenformat (ungleich Standard und Text) tragen?
Wozu soll das Ganze dienen?

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: Verwirrend von: Sparrow
Geschrieben am: 26.09.2014 09:25:16

Hey!
Es geht um letzteres, also es sollen in dieser Spalte alle Zellen identifiziert werden, die ein Zahlenformat ungleich Text bzw. Standard besitzen. Folglich sollen diese Zellen in Tabelle 2 abgesetzt werden - durch den Namen des Tabellenblatts in Spalte 1 sowie in Spalte 2 die Adresse der Zelle (z.B. B4) Danke für die Antwort!
Vg
Sascha


  

Betrifft: immer noch verwirrend :-( von: Erich G.
Geschrieben am: 26.09.2014 10:46:26

Hi Sascha,
meine letzte, wichtige Frage hast du nicht beantwortet: "Wozu soll das Ganze dienen?"

Wofür ist die Formatierung einer Zelle relevant? Meist dürfte der Wert, der in der Zelle steht, wichtiger sein...

Du willst aus Tabellenblättern die Zellen herausgesucht haben, die nicht mit Standard oder Text formatiert sind.
In deiner Beispielmappe haben aber alle Zellen das Format "Standard". Wie soll man denn damit testen? :-(

Damit man überhaupt etwas finden kann, habe ich zwei Zellen auf einem zweiten Blatt anders formatiert.

Hier die Routine:

Option Explicit

Sub SuchFormat()
   Dim wks As Worksheet, rngC As Range, oDic As Object

   Set oDic = CreateObject("Scripting.Dictionary")
   For Each wks In ActiveWorkbook.Worksheets
      oDic.Add wks.Name & " wird durchsucht", ""      ' vielleicht nützlich
      For Each rngC In wks.UsedRange
         Select Case rngC.NumberFormat
            Case "General", "@"
            Case Else
               oDic.Add wks.Name & "!" & rngC.Address(0, 0), rngC.NumberFormatLocal
         End Select
      Next rngC
   Next wks
   Worksheets.Add Before:=Worksheets(1)
   With ActiveSheet
      .Columns("A:B").NumberFormat = "@"
      .Cells(1, 1).Resize(oDic.Count) = Application.Transpose(oDic.Keys)
      .Cells(1, 3).Resize(oDic.Count) = Application.Transpose(oDic.Items)
      .Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
         Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
         OtherChar:="!", FieldInfo:=Array(Array(1, 2), Array(2, 2))
   End With
End Sub
Und hier eine Mappe dazu: https://www.herber.de/bbs/user/92827.xlsm

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: immer noch verwirrend :-( von: Sparrow
Geschrieben am: 26.09.2014 11:44:48

Also, wir nehmen folgende Situation an: Ich habe eine Datei mit mehreren Tabellenblättern. In diesen Tabellenblättern befinden sich bestimmte Spalten mit Überschriften X,Y,Z etc. (dessen Position sich aber immer ändern kann) sowie eine Spalte B, die Fix ist. In diesen Spalten befinden sich Werte, die einerseits als Zahl formatiert sind oder als Text (aus dem Grund das Excel aus 0001 bei Zahlenformat eine 1 macht musst ich die Zelle als Text formatieren). Nun möchte ich herausfinden, welche Zelle in den genannten Spalten das Format Zahl besitzt und diese Zelle auf einem neuen Tabellenblatt ausgeben lassen (Spalte 1: Name des Tabellenblatts; Spalte 2: Adresse der Zelle), damit ich weiß welche noch das Zahlenformat besitzt!
Nochmals vielen Dank
VG
Sascha


  

Betrifft: na ja trotzdem... von: Erich G.
Geschrieben am: 26.09.2014 12:51:19

Hi Sascha,
auch wenn ich weiter davon ausgehe, dass die Formatierungen der Zellen nicht ausschlaggebend sind,
sondern dass es darauf ankommt, ob die Werte in deinen Zellen Zahlen oder Texte sind,
hier ein neuer Code, der nach Formaten sucht:

Sub SuchFormat2()
   Dim wks As Worksheet, rngC As Range, oDic As Object, arT
   Dim cc As Long, ii As Long

   Const ZeileUeb As Long = 6
   Const TexteUeb As String = "X|Z|G|H"

   Set oDic = CreateObject("Scripting.Dictionary")
   arT = Split(TexteUeb, "|")
   For Each wks In ActiveWorkbook.Worksheets
      With wks
         oDic.Add .Name & " wird durchsucht", ""             ' vielleicht nützlich
         For Each rngC In Intersect(.UsedRange, .Columns(2)) ' Spalte B=2 immer
            Select Case rngC.NumberFormat
               Case "General", "@"
               Case Else
                  oDic.Add .Name & "!" & rngC.Address(0, 0), ""
            End Select
         Next rngC
         For cc = 1 To .Cells(ZeileUeb, .Columns.Count).End(xlToLeft).Column
           For ii = 0 To UBound(arT)            ' Spalten mit best. Überschriften
               If .Cells(ZeileUeb, cc) = arT(ii) Then
                  For Each rngC In Intersect(.UsedRange, .Columns(cc))
                     Select Case rngC.NumberFormat
                        Case "General", "@"
                        Case Else
                           oDic.Add .Name & "!" & rngC.Address(0, 0), ""
                     End Select
                  Next rngC
               End If
            Next ii
         Next cc
      End With
   Next wks
   Worksheets.Add Before:=Worksheets(1)
   With ActiveSheet.Columns(1)
      .NumberFormat = "@"
      .Cells(1).Resize(oDic.Count) = Application.Transpose(oDic.Keys)
      .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
         Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
         OtherChar:="!", FieldInfo:=Array(Array(1, 2), Array(2, 2))
   End With
End Sub
Und hier die Mappe: https://www.herber.de/bbs/user/92833.xlsm

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: na ja trotzdem... von: Sparrow
Geschrieben am: 26.09.2014 13:32:34

Hey!
Leider kommt ein Fehler in der folgenden Zeile:

For Each rngC In Intersect(.UsedRange, .Columns(2)) ' Spalte B=2 immer

Laufzeitfehler 424 - Objekt erforderlich

Ne Idee? Vielen Dank!

Vg
Sascha


  

Betrifft: AW: na ja trotzdem... von: Jürgen V.
Geschrieben am: 26.09.2014 14:26:33

Hallo Sascha,

der Fehler resultiert wahrscheinlich daraus, dass es ein Blatt in der Datei gibt, das in Spalte A und B leer ist.

Noch eine Frage: wäre für Dich statt der Erstellung einer Liste der Zellen nicht nützlicher, wenn die Zellen direkt korrigiert würden (also auf Text-Format umstellen und mit Nullen auffüllen)?

Gruß, Jürgen


  

Betrifft: AW: na ja trotzdem... von: Sparrow
Geschrieben am: 26.09.2014 14:45:43

Hallo Jürgen,
leider nicht, da nicht klar ist wie viele Nullen davor kommen - das sind bestimmte Kennzahlen die nachträglich dann überprüft werden müssen und neu eigegeben werden.
Wie könnte ich das Problem lösen wenn diese Spalten leer wären?
Vg
Sascha


  

Betrifft: AW: na ja trotzdem... von: Jürgen V.
Geschrieben am: 26.09.2014 15:43:08

Hallo Sascha,

wegen der führenden Nullen: ist denn bekannt, wie viele Stellen es insgesamt sein sollen? Dann lässt sich das auch automatisieren.

Um den Laufzeitfehler zu vermeiden, habe ich den von Erich entwickelten Code noch um eine Prüfung erweitert:

Sub SuchFormat2()
Dim wks As Worksheet, rngC As Range, oDic As Object, arT
Dim cc As Long, ii       As Long

Const ZeileUeb           As Long = 6
Const TexteUeb           As String = "X|Z|G|H"

Set oDic = CreateObject("Scripting.Dictionary")
arT = Split(TexteUeb, "|")
For Each wks In ActiveWorkbook.Worksheets
   With wks
      oDic.Add .Name & " wird durchsucht", ""             ' vielleicht nützlich
      If Not Intersect(.UsedRange, .Columns(2)) Is Nothing Then
         For Each rngC In Intersect(.UsedRange, .Columns(2))   ' Spalte B=2 immer
            Select Case rngC.NumberFormat
            Case "General", "@"
            Case Else
               oDic.Add .Name & "!" & rngC.Address(0, 0), ""
            End Select
         Next rngC
         For cc = 1 To .Cells(ZeileUeb, .Columns.Count).End(xlToLeft).Column
            For ii = 0 To UBound(arT)            ' Spalten mit best. Überschriften
               If .Cells(ZeileUeb, cc) = arT(ii) Then
                  For Each rngC In Intersect(.UsedRange, .Columns(cc))
                     Select Case rngC.NumberFormat
                     Case "General", "@"
                     Case Else
                        oDic.Add .Name & "!" & rngC.Address(0, 0), ""
                     End Select
                  Next rngC
               End If
            Next ii
         Next cc
      End If
   End With
Next wks
Worksheets.Add Before:=Worksheets(1)
With ActiveSheet.Columns(1)
   .NumberFormat = "@"
   .Cells(1).Resize(oDic.Count) = Application.Transpose(oDic.Keys)
   .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                  Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
                  OtherChar:="!", FieldInfo:=Array(Array(1, 2), Array(2, 2))
End With
End Sub

Gruß, Jürgen


  

Betrifft: AW: na ja trotzdem... von: Sparrow
Geschrieben am: 26.09.2014 15:50:24

Hey Jürgen!
Nein, ist leider nicht bekannt - aber das läuft so wunderbar! Vielen vielen Dank!
Da ich selber dazulernen möchte um nicht mehr fragen zu müssen wär es super wenn du ggf. nochmal zu den Zeilen schreiben würdest was da gemacht wird bzw. wozu das da ist!
Falls nicht auch kein Problem - nochmals vielen Dank!

Beste Grüße
Sascha


  

Betrifft: AW: na ja trotzdem... von: Jürgen V.
Geschrieben am: 26.09.2014 16:00:28

Hallo Sascha,

den Dank solltest Du an Erich richten, der den Code entwickelt hat (von mir stammt ja nur eine kleine Ergänzung).

Aber wenn Du die Nullen von Hand auffüllst, muss doch irgendwie klar sein, wie viele Stellen es insgesamt sein müssen, oder? Werden die Daten eigentlich von Hand eingegeben oder importiert? Im letzteren Fall lässt sich ja auch schon dabei das Problem möglicherweise vermeiden...

Gruß, Jürgen


  

Betrifft: Vielen Dank und ein schönes WE! von: Sparrow
Geschrieben am: 26.09.2014 16:23:52

Die Daten werden importiert - und natürlich, einen großen Dank an Erich und auch Klaus! Super Hilfe!
Und falls jmd Lust hat könnte den Code kurz kommentieren damit ich in Zukunft weniger nachfragen muss ;)
Ein wunderschönes Wochenende!
Beste Grüße

Sascha


  

Betrifft: kleine Korrektur von: Erich G.
Geschrieben am: 26.09.2014 16:58:01

Hi Sascha,
ein klein wenig habe ich noch geändert am Code:

Option Explicit

Sub SuchFormat3()
   Dim wks As Worksheet, rngC As Range, oDic As Object, arT
   Dim cc As Long, ii As Long

   Const ZeileUeb As Long = 6
   Const TexteUeb As String = "X|Z|G|H"

   Set oDic = CreateObject("Scripting.Dictionary")
   arT = Split(TexteUeb, "|")
   For Each wks In ActiveWorkbook.Worksheets
      With wks
         oDic.Add .Name & " wird durchsucht", ""             ' vielleicht nützlich
         If Not Intersect(.UsedRange, .Columns(2)) Is Nothing Then
            For Each rngC In Intersect(.UsedRange, .Columns(2)) ' Spalte B=2 immer
               Select Case rngC.NumberFormat
                  Case "General", "@"
                  Case Else
                     oDic.Add .Name & "!" & rngC.Address(0, 0), ""
               End Select
            Next rngC
         End If
         For cc = 1 To .Cells(ZeileUeb, .Columns.Count).End(xlToLeft).Column
            If cc <> 2 Then
               For ii = 0 To UBound(arT)            ' Spalten mit best. Überschriften
                  If .Cells(ZeileUeb, cc) = arT(ii) Then
                     For Each rngC In Intersect(.UsedRange, .Columns(cc))
                        Select Case rngC.NumberFormat
                           Case "General", "@"
                           Case Else
                              oDic.Add .Name & "!" & rngC.Address(0, 0), ""
                        End Select
                     Next rngC
                  End If
               Next ii
            End If
         Next cc
      End With
   Next wks
   Worksheets.Add Before:=Worksheets(1)
   With ActiveSheet.Columns(1)
      .NumberFormat = "@"
      .Cells(1).Resize(oDic.Count) = Application.Transpose(oDic.Keys)
      .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
         Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
         OtherChar:="!", FieldInfo:=Array(Array(1, 2), Array(2, 2))
   End With
End Sub

Sub SuchZahlen()
   Dim wks As Worksheet, rngC As Range, oDic As Object, arT
   Dim cc As Long, ii As Long

   Const ZeileUeb As Long = 6
   Const TexteUeb As String = "X|Z|G|H"

   Set oDic = CreateObject("Scripting.Dictionary")
   arT = Split(TexteUeb, "|")
   For Each wks In ActiveWorkbook.Worksheets
      With wks
         oDic.Add .Name & " wird durchsucht", ""             ' vielleicht nützlich
         If Not Intersect(.UsedRange, .Columns(2)) Is Nothing Then
            For Each rngC In Intersect(.UsedRange, .Columns(2)) ' Spalte B=2 immer
               If Application.IsNumber(rngC) Then _
                  oDic.Add .Name & "!" & rngC.Address(0, 0), rngC.Value2
            Next rngC
         End If
         For cc = 1 To .Cells(ZeileUeb, .Columns.Count).End(xlToLeft).Column
            If cc <> 2 Then
               For ii = 0 To UBound(arT)            ' Spalten mit best. Überschriften
                  If .Cells(ZeileUeb, cc) = arT(ii) Then
                     For Each rngC In Intersect(.UsedRange, .Columns(cc))
                        If Application.IsNumber(rngC) Then _
                           oDic.Add .Name & "!" & rngC.Address(0, 0), rngC.Value2
                     Next rngC
                  End If
               Next ii
            End If
         Next cc
      End With
   Next wks
   Worksheets.Add Before:=Worksheets(1)
   With ActiveSheet.Columns(1)
      .NumberFormat = "@"
      .Cells(1).Resize(oDic.Count) = Application.Transpose(oDic.Keys)
      .Cells(1).Offset(, 2).Resize(oDic.Count) = Application.Transpose(oDic.Items)
      .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
         Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
         OtherChar:="!", FieldInfo:=Array(Array(1, 2), Array(2, 2))
   End With
End Sub
"SuchZahlen" kannst du ja auch mal laufen lassen, vielleicht ist das ja auch interessant...

Den den "Code kurz zu kommentieren" ist nicht so einfach. Wo aufsetzen, wo anfangen, wo aufhören?
Wie sind deine Vorkenntnisse?
Besser wäre es, du würdest konkrete Fragen stellen. Zunächst dir, dann der VBA-Hilfe,
der Recherche hier im Forum, Google o.ä., und dann - wenn noch nötig - hier in einem Beitrag. :-)

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schönes Wochenende allerseits!


  

Betrifft: AW: Feld-Format "Zahl" suchen und ausgeben lassen von: Adis
Geschrieben am: 26.09.2014 12:38:30

Hallo

anbei ein kurzes Makro was m. Erachtens dieses Problem endgültig lösen wird
Eine neue Tabelle Sheets("zFormat") anlegen, Makro in Modul1 kopieren und starten.
Ich habe das Standard Format in Const als "General" angegeben, weil manche Computer
für das normale Standard Format den Text "Standard" benutzen. ggf. Text korrigieren.

Im zFormat Blatt wird die Zell Adresse und der aktuelle Wert angegeben.
Würde mich freuen wenn es zufriedenstellend klappt.

Const Standard = "General" '"Standard"

Sub TextFormat_suchen()
Dim Zeilen As Long, Spalten As Long
Dim ZF As Object, a, s, z
Set ZF = Sheets("zFormat")
' Sheets("Tabelle1").Select
   'Überschrift Text in zFormat Tabelle
   ZF.Cells(1, 3) = "Wert"
   ZF.Cells(1, 2) = "Adresse"
   'UsedRange Anzahl Zeilen und Spalten laden
   Zeilen = Cells.SpecialCells(xlLastCell).Row
   Spalten = Cells.SpecialCells(xlLastCell).Column
   a = 2  '1. Zeile in zFormat Tabelle
   'Schleife für ganze Zeile auf "Standard" prüfen
   For z = 1 To Zeilen
      If Rows(z).NumberFormat = Standard Then
      Else  'Schleife für jede Zelle auf "Text" prüfen
      For s = 1 To Spalten  'gefundene Zellen auflisten
          If Cells(z, s).NumberFormat = "@" Then
             ZF.Cells(a, 2) = Cells(z, s).Address(, 0)
             ZF.Cells(a, 3) = "'" & Cells(z, s).Value
             ZF.Cells(a, 1) = a - 1: a = a + 1
          End If
      Next s
      End If
   Next z
End Sub
gruss Adis


 

Beiträge aus den Excel-Beispielen zum Thema "Feld-Format "Zahl" suchen und ausgeben lassen"