AW: Code läuft im Freigabemodus nicht
01.08.2011 20:12:57
fcs
Hallo shellbeach,
die Funktion "Text in Spalten" kann in freigegebenen Arbeitsmappen nicht per Makro ausgeführt werden - ist ja auch manuell nicht möglich.
Evtl. funktioniert es, die Zellinhalte zeilenweise aufzubereiten, z.B. mit einem der nachfolgendem Makros.
Variante 01 - wenn in den Texten keine Anführungszeichen als Textqualifier vorkommen
Variante 02 - wenn in den Texten Anführungszeichen als Textqualifier vorkommen
Gruß
Franz
Sub NewSheet_Split_Var01()
Dim Quelle As Worksheet
Dim Zwi As Worksheet
Dim sTemp, iTemp As Long, Spalte As Long, Zeile As Long, vTemp
Dim Bereich As Range
Set Quelle = ActiveSheet
Worksheets.Add
Set Zwi = ActiveSheet
Quelle.Columns("A:A").Copy Destination:=Zwi.Range("A1")
With Zwi
For Zeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
sTemp = .Cells(Zeile, 1).Text
If sTemp "" Then
'Trennzeichen "-" durch ";" ersetzen
sTemp = Replace(sTemp, "-", ";")
'Textinhalte am ";" splitten
vTemp = Split(sTemp, ";")
Spalte = 0
For iTemp = LBound(vTemp) To UBound(vTemp)
Spalte = Spalte + 1
With .Cells(Zeile, Spalte)
.Value = vTemp(iTemp)
'Datums- und nummerische Werte nachbereiten
If IsDate(.Text) Then
If InStr(1, .Text, ",") > 0 And IsNumeric(.Text) Then
.Value = CDbl(.Text)
Else
.Value = CDate(.Text)
End If
ElseIf IsNumeric(.Text) Then
.Value = CDbl(.Text)
End If
End With
Next
End If
Next Zeile
End With
End Sub
Sub NewSheet_Split_Var02()
Dim Quelle As Worksheet
Dim Zwi As Worksheet
Dim sTemp As String, iTemp As Long, Spalte As Long, Zeile As Long, sTemp1 As String, vTemp
Set Quelle = ActiveSheet
Const sSp As String = vbCr 'neues Trennzeichen für Spalten (Zeichen, das im Text nicht _
vorkommt _
z.B TAB ~ § ³ ² µ oder |
Worksheets.Add
Set Zwi = ActiveSheet
Quelle.Columns("A:A").Copy Destination:=Zwi.Range("A1")
With Zwi
For Zeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
sTemp = .Cells(Zeile, 1).Text
sTemp1 = ""
If sTemp "" Then
Spalte = 0
For iTemp = 1 To Len(sTemp)
Select Case Mid(sTemp, iTemp, 1)
Case ";", "-" 'Spaltentrennzeichen
'Prüfen, ob nach dem Spaltentrennzeichen ein Anführungszeichen steht
If Mid(sTemp, iTemp, 2) = "-""" Or Mid(sTemp, iTemp, 2) = ";""" Then
'Spaltentrennzeichen + Anführungszeichen durch neues Trennzeichen ersetzen
sTemp1 = sTemp1 & sSp & "'"
'Spaltentrennzeichen + Anführungszeichen überspringen
iTemp = iTemp + 2
'alles Zeichen bis zur Zeichenfolge Anführungszeichen + Spaltentrennzeichen _
einlesen
Do Until Mid(sTemp, iTemp, 2) = """-" Or Mid(sTemp, iTemp, 2) = """;" _
Or iTemp >= Len(sTemp)
sTemp1 = sTemp1 & Mid(sTemp, iTemp, 1)
iTemp = iTemp + 1
Loop
'Anführungszeichen + Spaltentrennzeichen durch neues Trennzeichen ersetzen
sTemp1 = sTemp1 & sSp
iTemp = iTemp + 1
Else
sTemp1 = sTemp1 & sSp 'Spaltentrennzeichen durch neues Trennzeichen ersetzen
End If
Case Else
sTemp1 = sTemp1 & Mid(sTemp, iTemp, 1)
End Select
Next
sTemp = sTemp1
vTemp = Split(sTemp, sSp)
Spalte = 0
For iTemp = LBound(vTemp) To UBound(vTemp)
Spalte = Spalte + 1
With .Cells(Zeile, Spalte)
.Value = vTemp(iTemp)
'Datums- und nummerische Werte nachbereiten
If IsDate(.Text) Then
If InStr(1, .Text, ",") > 0 And IsNumeric(.Text) Then
.Value = CDbl(.Text)
Else
.Value = CDate(.Text)
End If
ElseIf IsNumeric(.Text) Then
.Value = CDbl(.Text)
End If
End With
Next
End If
Next Zeile
End With
End Sub