DIV/X! durch Array in anderes Format bringen
01.04.2016 14:40:05
Sav
kann mir bitte jemand sagen wieso Spalten in der "Ausgangstabelle" mit dem Wert "DIV/X!" ignoriert werden durch das Array? Ich würde diese Werte auch gerne in das andere Datenformat überführen.
Der Code stammt von "Tino". Leider kann ich in meinen alten Beitrag kein Kommentar mehr beifügen.
Grundsätzlich bringt das Makro Daten in der Form
A1 B C
A2 B C
A3 B C
In die Form
A1 B
A2 B
A3 B
A1 C
A2 C
A3 C
Problem:
A1 DIV/X C
A2 B C
A3 DIV/X C
wird zu
A2 B
A1 C
A2 C
A3 C
Ergebnis soll aber
A1 DIV/X
A2 B
A3 DIV/X
A1 C
A2 C
A3 C
sein.
Option Explicit
Sub Beispiel()
Dim ArData, ArNew()
Dim n&, nn&, nnn&
On Error GoTo ErrorHandler:
With Sheets(Sheets("Auswertungstabelle").Range("B2").Value) 'Ausgangstabelle evtl. anpassen
'Datenbereich evtl. anpassen
'Datenbereich hier ab A2
'bis zur letzten Zelle in Spalte A
'bis zu letzten Zelle in Zeile 1
With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).EntireRow
If .Rows(.Rows.Count).Row
Sub 'keine Daten
With .Columns(1).Resize(, .Cells(2, .Columns.Count).End(xlToLeft).Column)
If .Columns(.Columns.Count).Column = 1 Then Exit
Sub 'keine Daten
ArData = .Value
End With
End With
End With
ReDim ArNew(1 To UBound(ArData) * UBound(ArData, 2), 1 To 6)
nnn = 1
ArNew(nnn, 1) = "Kriterium"
ArNew(nnn, 2) = "Wert"
ArNew(nnn, 3) = "Datum"
ArNew(nnn, 4) = "Woche"
ArNew(nnn, 5) = "Monat"
ArNew(nnn, 6) = "Wochentag"
For nn = 2 To UBound(ArData, 2)
If ArData(1, nn) "" Then
For n = 2 To UBound(ArData)
'If Not IsError(ArData(n, nn)) Then
If ArData(n, nn) "" Then
nnn = nnn + 1
ArNew(nnn, 1) = ArData(n, 1)
ArNew(nnn, 2) = ArData(n, nn)
ArNew(nnn, 3) = ArData(1, nn)
ArNew(nnn, 4) = "=WEEKNUM(RC[-1])" 'KW
ArNew(nnn, 5) = "=MONTH(RC[-2])" 'Monat
ArNew(nnn, 6) = "=WEEKDAY(RC[-3])" 'Tag
End If
'End If
Next n
' End If
Next nn
'Ausgabe in neue Tabelle
With ThisWorkbook
With .Sheets("Auswertungstabelle")
.Range("A25", .Cells(.Rows.Count, 6)).Clear
With .Cells(26, 1).Resize(UBound(ArNew), UBound(ArNew, 2))
.Columns(3).NumberFormat = "dd.mm.yyyy"
.Rows(1).Font.Bold = True
.Rows(1).HorizontalAlignment = xlCenter
.FormulaR1C1 = ArNew
.EntireColumn.AutoFit 'Spaltenbreite anpassen
End With
End With
End With
ErrorHandler:
If Err.Number 0 Then
MsgBox Err.Description, vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub