Microsoft Excel

Herbers Excel/VBA-Archiv

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

Text in Spalten; "0" werte | Herbers Excel-Forum


Betrifft: Text in Spalten; "0" werte von: Maxkuba
Geschrieben am: 04.01.2010 06:43:56

Hallo Kollegen,
bitte helft mir doch meinen Datenbankauszug, welcher in csv erfolgt, in Excel so einzufuegen, dass die Bauteilenummern welche sich in Spalte 12 befinden(von vorne gezaehlt) als Text formatiert werden, bzw das die "0" Werte am beginn der Zeile erhalten bleiben.
Bspl.:

Bauteilenummer vor import: 0123456
Bauteilenummer nach import: 123456

Die Null wird von Excel eliminiert.. das soll aber nicht so sein... das komische ist das die Spalte tortzdem als Txt fromatiert ist.

Das ist der Code den ich mit dem Makrorecorder aufgenommen habe:

 Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 2), Array(  _
_
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),   _
_
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
 _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
 _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65,  _
 _
1), _
        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1),  _
Array( _
        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78,  _
 _
1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1),  _
Array( _
        85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1), Array(90, 1), Array(91,  _
 _
1), _
        Array(92, 1), Array(93, 1), Array(94, 1), Array(95, 1), Array(96, 1), Array(97, 1),  _
Array( _
        98, 1), Array(99, 1), Array(100, 1), Array(101, 1), Array(102, 1), Array(103, 1), Array( _
 _
104 _
        , 1), Array(105, 1), Array(106, 1), Array(107, 1), Array(108, 1), Array(109, 1), Array(  _
_
110, _
        1), Array(111, 1), Array(112, 1), Array(113, 1), Array(114, 1), Array(115, 1), Array( _
116, 1 _
        ), Array(117, 1), Array(118, 1), Array(119, 1), Array(120, 1), Array(121, 1), Array(122, _
 _
 1) _
        , Array(123, 1), Array(124, 1), Array(125, 1), Array(126, 1), Array(127, 1), Array(128,  _
 _
1), _
        Array(129, 1), Array(130, 1)), TrailingMinusNumbers:=True
Wenn Ihr wollt, dann poste ich das ganze Makro, ist aber sehr lange..

Viele Gruesse, Max

  

Betrifft: AW: Text in Spalten; "0" werte von: fcs
Geschrieben am: 04.01.2010 08:08:51

Hallo Max,

von der Parameter 2 für die Spalte 12, um diese als Text einzulesen scheint ja ok zu sein.

Dein Feldtrennzeichen ist jedoch Komma. Da könnte es evtl. ein Problem geben,wenn Komma auch als Dezimaltrennzeichen eingestellt ist, was bei Deutscher Version normalerweise der Fall ist.

verwende als zusätzlichen Parameter

    Range("A:A").TextToColumns Destination:=Range("A1"), .....
         ....., Array(130, 1)), DecimalSeparator:=".", _
        TrailingMinusNumbers:=True
evtl. hilft es ja.
Wie sieht den der Inhat in einer Zelle in Spalte A aus?

Ansonsten kannst du noch versuchen, die Daten via Daten -- externe Daten importieren direkt spaltenrichtig einzulesen.

Gruß
Franz


  

Betrifft: AW: Text in Spalten; "0" werte von: Maxkuba
Geschrieben am: 04.01.2010 09:18:57

Hallo Franz,
danke fuer die Antwort. Das mit manuell txt in spalten will ich eben nicht machen, da ich mir mit dem makro zeit sparen will.
Leider bringt das mit dem Decimalseperator in diesem Zusammenhang nichts. Habe es ausprobiert.

Hat vieleicht noch jemand eine Loesung?

Hier ein Beispielfile:

https://www.herber.de/bbs/user/66968.txt


Viele Gruesse, Max


  

Betrifft: AW: Text in Spalten; "0" werte von: Klaus-Dieter
Geschrieben am: 04.01.2010 10:53:34

Hallo Max,

es ist durchaus nicht so, dass ein Makro schneller ist, als eine Standardfunktion. Oft ist das Gegenteil der Fall.



Viele Grüße Klaus-Dieter

Klaus-Dieter's Excel und VBA Seite
Online-Excel



  

Betrifft: AW: Text in Spalten; "0" werte von: fcs
Geschrieben am: 04.01.2010 10:54:17

Halo Max,

ich hab noch ein wenig mit deiner Textdatei experimentiert.
Das folgende Makro fürht zu einem zufriedenstellenden Ergebnis. Evtl. muss du noch weitere Anpassungen machen.

Gruß
Franz

Sub Test()
  Dim sFile, arrFieldInfo() As Long, Spalte As Long, Zelle As Range
  Dim wks As Worksheet, wksZiel As Worksheet, wbText As Workbook
  'Textdatei auswählen
  sFile = Application.GetOpenFilename(FileFilter:="Text(*.txt),*.txt", _
        Title:="Bitte Datendatei auswählen")
  If sFile <> False Then
    'Tabellenblatt in dem die Inhalte der Textdatei eingefügt werden sollen
    Set wksZiel = ActiveSheet
    'Spaltenformate festlegen
    ReDim arrFieldInfo(1 To 12, 1 To 2)
    For Spalte = 1 To 12
      arrFieldInfo(Spalte, 1) = Spalte
      Select Case Spalte
        Case 12
          arrFieldInfo(Spalte, 2) = 2 'Text
        Case Else
          arrFieldInfo(Spalte, 2) = 1 'Standard
      End Select
    Next
    'Textdatei öffnen
    Application.Workbooks.OpenText Filename:=sFile, startrow:=1, _
      DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, _
      consecutivedelimiter:=False, _
      Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
      DecimalSeparator:=".", TrailingMinusnumbers:=True, Local:=False, _
      Fieldinfo:=arrFieldInfo
    Set wbText = ActiveWorkbook
    Set wks = wbText.Worksheets(1)
    With wks
      'Spaltenbreite = Autofit
      .UsedRange.EntireColumn.AutoFit
      'In bestimmten Spalten Hochkommata durch Leerstring ersetzen
        'Dabei werden die nummerischen und Datumswerte in den Zellen konvertiert
      .Columns(3).Replace what:="'", replacement:="", lookat:=xlPart
      .Columns(8).Replace what:="'", replacement:="", lookat:=xlPart
      .Range(.Columns(10), .Columns(11)).Replace what:="'", replacement:="", lookat:=xlPart
      'In allen Zellen Wertersetzungen durchführen - konvertiert das führende _
        Hochkomma in unsichtbares Text-Kennzeichen
      For Each Zelle In .UsedRange
        Zelle.Value = Zelle.Value
      Next
      'Daten in Zieltabelle kopieren - beginnend in Zelle A1
      .UsedRange.Copy Destination:=wksZiel.Cells(1, 1)
    End With
    'Textdatei wieder schliessen ohne speichern
    wbText.Close savechanges:=False
  End If
End Sub



  

Betrifft: AW: Text in Spalten; "0" werte von: Maxkuba
Geschrieben am: 04.01.2010 11:24:45

Hallo Franz,
alleinstehend funktioniert es wunderbar, jedoch passt es jetzt nicht mehr zum Rest meines "zusammengebastelten" Makros.
Koenntest du dich meiner nochmal annehmen? Leider kann ich den Zusammenhang nicht finden warum jetzt einige Berechnungen nicht mehr vollzogen werden.
Auf jeden Fall schonmal Danke fuer deine Zeit die du bis jetzt investiert hast. Vielen Dank!

PS.: Der Datenbankexport ist ca 130 Spalten breit, und bitte luencht mich nicht wegen der stuemperhaften selects usw.. :-)

Sub Test()
'Definition globale Variable für Range!
Dim lngLast
    lngLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

S = Now
Debug.Print "Start ZDZt:" + Format(DateDiff("s", S, Now()))

'Screenupdating = False!
Application.ScreenUpdating = False

'Name des Datenblattes= database
Sheets(1).Name = "database"
Sheets(1).Activate

'Formatieren der Spalten
Rows("2:2").Delete
' Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
'        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
'        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
'        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1),  _
_
'        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 2), Array( _
13, 1 _
'        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
'        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array( _
26, 1), _
'        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
'        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, _
 1), _
'        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
'        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, _
 1), _
'        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
'        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, _
 1), _
'        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1),  _
Array( _
'        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78, _
 1), _
'        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1),  _
Array( _
'        85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1), Array(90, 1), Array(91, _
 1), _
'        Array(92, 1), Array(93, 1), Array(94, 1), Array(95, 1), Array(96, 1), Array(97, 1),  _
Array( _
'        98, 1), Array(99, 1), Array(100, 1), Array(101, 1), Array(102, 1), Array(103, 1),  _
Array(104 _
'        , 1), Array(105, 1), Array(106, 1), Array(107, 1), Array(108, 1), Array(109, 1), Array( _
110, _
'        1), Array(111, 1), Array(112, 1), Array(113, 1), Array(114, 1), Array(115, 1), Array( _
116, 1 _
'        ), Array(117, 1), Array(118, 1), Array(119, 1), Array(120, 1), Array(121, 1), Array( _
122, 1) _
'        , Array(123, 1), Array(124, 1), Array(125, 1), Array(126, 1), Array(127, 1), Array(128, _
 1), _
'        Array(129, 1), Array(130, 1)), TrailingMinusNumbers:=True, DecimalSeparator:="."








  Dim sFile, arrFieldInfo() As Long, Spalte As Long, Zelle As Range
  Dim wks As Worksheet, wksZiel As Worksheet, wbText As Workbook
  'Textdatei auswählen
  sFile = Application.GetOpenFilename(FileFilter:="Text(*.txt),*.txt", _
        Title:="Bitte Datendatei auswählen")
  If sFile <> False Then
    'Tabellenblatt in dem die Inhalte der Textdatei eingefügt werden sollen
    Set wksZiel = ActiveSheet
    'Spaltenformate festlegen
    ReDim arrFieldInfo(1 To 150, 1 To 2)
    For Spalte = 1 To 150
      arrFieldInfo(Spalte, 1) = Spalte
      Select Case Spalte
        Case 12
          arrFieldInfo(Spalte, 2) = 2 'Text
        Case Else
          arrFieldInfo(Spalte, 2) = 1 'Standard
      End Select
    Next
    'Textdatei öffnen
    Application.Workbooks.OpenText Filename:=sFile, startrow:=1, _
      DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, _
      consecutivedelimiter:=False, _
      Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
      DecimalSeparator:=".", TrailingMinusnumbers:=True, Local:=False, _
      Fieldinfo:=arrFieldInfo
    Set wbText = ActiveWorkbook
    Set wks = wbText.Worksheets(1)
    With wks
      'Spaltenbreite = Autofit
      .UsedRange.EntireColumn.AutoFit
      'In bestimmten Spalten Hochkommata durch Leerstring ersetzen
        'Dabei werden die nummerischen und Datumswerte in den Zellen konvertiert
      .Columns(3).Replace what:="'", replacement:="", lookat:=xlPart
      .Columns(8).Replace what:="'", replacement:="", lookat:=xlPart
      .Range(.Columns(10), .Columns(11)).Replace what:="'", replacement:="", lookat:=xlPart
      'In allen Zellen Wertersetzungen durchführen - konvertiert das führende _
        Hochkomma in unsichtbares Text-Kennzeichen
      For Each Zelle In .UsedRange
        Zelle.Value = Zelle.Value
      Next
      'Daten in Zieltabelle kopieren - beginnend in Zelle A1
      .UsedRange.Copy Destination:=wksZiel.Cells(1, 1)
    End With
    'Textdatei wieder schliessen ohne speichern
    wbText.Close savechanges:=False
  End If









Rows("1:1").Interior.ColorIndex = 15
Rows("1:1").Interior.Pattern = xlSolid

Cells.Replace what:="'", replacement:="", lookat:=xlPart
Range("1:1").Select
ActiveWindow.Zoom = 80
Selection.Font.Bold = True

DoEvents
Debug.Print "ZDZt nach Formatierung der Spalten:" + Format(DateDiff("s", S, Now()))

'PVO Formeln:
'SAvr PVO 2008

        Range("DZ2").Select
        ActiveCell.FormulaR1C1 = "=RC[-80]*RC[-83]/RC[-122]"
        Range("DZ2").Select
            Selection.AutoFill Destination:=Range("DZ2:DZ" & lngLast), Type:=xlFillDefault
        Range("DZ2:DE" & lngLast).Select
        Range("DZ1").Select
        ActiveCell.FormulaR1C1 = "SPVO 2008"
        Range("DZ2").Select
        Columns("DZ:DZ").EntireColumn.AutoFit

      'SAvr PVO 2009
        Range("EA2").Select
        ActiveCell.FormulaR1C1 = "=RC[-77]*RC[-80]/RC[-123]"
        Range("EA2").Select
            Selection.AutoFill Destination:=Range("EA2:EA" & lngLast), Type:=xlFillDefault
        Range("EA2:DE" & lngLast).Select
        Range("EA1").Select
        ActiveCell.FormulaR1C1 = "SPVO 2009"
        Range("EA2").Select
        Columns("EA:EA").EntireColumn.AutoFit

       'APR
        Range("EB2").Select
        ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-78]>0,RC[-82]>0),(RC[-78]-RC[-82])*RC[-81]/RC[-124], """")"
         Range("EB2").Select
            Selection.AutoFill Destination:=Range("EB2:EB" & lngLast), Type:=xlFillDefault
        Range("EB2:DE" & lngLast).Select
        Range("EB1").Select
        ActiveCell.FormulaR1C1 = "APR"
        Range("EB2").Select
        Columns("EB:EB").EntireColumn.AutoFit

       'APR_PCT
        Range("EC2").Select
        ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-83]>0,RC[-79]>0),((RC[-79]-RC[-83])*RC[-82]/RC[-125])/(RC[-82]*RC[-79]/RC[- _
125]),"""")"
         Range("EC2").Select
            Selection.AutoFill Destination:=Range("EC2:EC" & lngLast), Type:=xlFillDefault
        Range("EC2:DE" & lngLast).Select
        Range("EC1").Select
        ActiveCell.FormulaR1C1 = "APR_PCT"
        Columns("EC:EC").EntireColumn.AutoFit
        
        'Combo
       
        
        

'Teilergebnisse
Rows("1:1").Select
Selection.Insert Shift:=xlDown

Range("DZ1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[2]C:R[15000]C)"

Range("EA1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[2]C:R[15000]C)"

Range("EB1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[2]C:R[15000]C)"

Range("EC1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-2]"

'Format Berechnete Zellen
Columns("DZ:EB").NumberFormat = "#,##0"
Columns("EC:EC").NumberFormat = "0.0%"

    Range("EC3:EC" & lngLast).Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
        Formula1:="-0.6"
    With Selection.FormatConditions(1).Font
        .Bold = False
        .Italic = True
        .ColorIndex = 3
    End With
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="0.6"
    With Selection.FormatConditions(2).Font
        .Bold = False
        .Italic = True
        .ColorIndex = 3
    End With

'Insert "x"
Range("ED2").Select
ActiveCell.FormulaR1C1 = "x"

'Autofilter
Rows("2:2").AutoFilter
Cells.Columns.AutoFit

'Gruppieren
Columns("S:DY").Select
Range("DY1").Activate
Selection.Columns.Group
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

Columns("O:Q").Select
Range("Q1").Activate
Selection.Columns.Group
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

Columns("M:M").Select
Range("M1").Activate
Selection.Columns.Group
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

Columns("e:k").Select
Range("K1").Activate
Selection.Columns.Group
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

'Split
ActiveWindow.SplitRow = 2
ActiveWindow.FreezePanes = True


'Combo
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A3").FormulaR1C1 = "=RC[1]&RC[12]&RC[23]"
    Range("A3").AutoFill Destination:=Range("A3:A" & lngLast), Type:=xlFillDefault
Range("A3:A" & lngLast).Select
Range("A2").FormulaR1C1 = "COMBO"

Columns("A:A").Copy
Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A:A").Columns.Group
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

Application.Calculate

'Aussortieren der fehlerhaften Berechnugen
Dim rng As Range, cell As Range, fmla As String
    Set rng = Cells.SpecialCells(xlCellTypeFormulas, 16)
For Each cell In rng
    fmla = Right(cell.Formula, Len(cell.Formula) - 1)
    cell.Formula = "=if(iserror(" & fmla & "), """"," & fmla & ")"
Next

Application.Calculate

End Sub



  

Betrifft: AW: Text in Spalten; "0" werte von: fcs
Geschrieben am: 04.01.2010 21:48:55

Hallo Max,

hauptproblem dürfte sein, dass noch nicht alle Spalten mit Zahlenwerten, die in den Formeln verwendet werden in Zahlen umgewandelt werden.

Ich hab die Prozedur angepasst und auch die Selects/Selection beseitigt.

Eine Zeile hab ich mit ??? gekennzeichnet. ich weiss nicht, ob die Zeile 2 nach dem einlesen der Daten noch gelöscht werden muss.

Gruß
Franz

Wegen der Länge der Code hier als Textdatei.
https://www.herber.de/bbs/user/66983.txt


  

Betrifft: AW: Text in Spalten; "0" werte von: Maxkuba
Geschrieben am: 05.01.2010 07:54:29

Hallo Franz,
wow vielen vielen Dank fuer das Bearbeiten des Makros. Sieht jetz auch gleich viel professioneller aus :-).. *freu*.

Funktioniert einwandfrei. Mochmals vielen Dank. Auf euch ist halt doch verlass..

Gruesse aus Indien, Max