2. W przypadku, gdy Excel część dat potraktował jak daty a część jak łańcuchy tekstowe, cały zakres dat zaznaczam i traktuję makrem:
Sub PoprawDaty()
For Each cell In Selection
If IsDate(cell.Value) And cell.NumberFormat <> "yyyy-mm-dd" Then
With cell
.NumberFormat = "yyyy-mm-dd"
.Value = DateValue(.Value)
End With
End If
Next cell
End Sub
Działa.
Czasetm zdarza się też, że dane liczbowe wklejone z innego źródła (ACE SQL, baza danych mainframe, tabelka w przeglądarce) są traktowane jak tekst i dopiero po edycji (kliknięciu i zaakceptowaniu, F2 i enter) nagle Excel przyjmuje prawidłowy format. Przecież nie będziemy klikać kilka tysięcy razy. W moim przypadku, np. w przypadku danych, które prawidłowo powinny być w formacie "Currency" działa coś takiego (jest to przeróbka kodu powyższego):
Sub PoprawWartosci()
For Each cell In Selection
' If IsNumeric(cell.Value) And cell.NumberFormat <> "#,##0.00 $" Then
With cell
.NumberFormat = "#,##0.00 $"
.Value = CCur(.Value)
End With
'End If
Next cell
End Sub
A tutaj wariant, który poprawia konkretną kolumnę w konkretnej tabeli(fragment kodu):
Dim oListObj As ListObject
Set oListObj = Worksheets("Oferta").ListObjects("Table3")
For Each Cell In oListObj.ListColumns("wartosc").Range
'If Not IsNumeric(Cell.Value) And Cell.NumberFormat = "#,##0.00 $" Then
With Cell
If .Value <> "" Then
.NumberFormat = "#,##0.00 $"
.Value = CCur(Val(.Value))
End If
End With
Next Cell
Zdarza się, że Excel nie traktuje tekstów jak teksty, wtedy na początku każdej komórki dodaję apostrof:
Sub DodajApostrofPoLewej()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Selection
If Left(c, 1) <> "'" Then c.Value = "'" & c.Value
Next
Application.ScreenUpdating = True
End Sub
Zdarza się też, że dane skopiowane ze strony internetowej zawiarają puste komórki, a excel twierdzi, że jednak jest w nich coś (Count w pasku stanu nie równa się 0)i nie chce liczyć zakresów zawierających takie komórki. Mój trik, to wpisanie do wszystkich pustych komórek wartości 0 a następnie usunięcie wszystkich zer :
Sub clean_up()
Selection.Replace What:="", Replacement:="0", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
3. Teraz pozostaje np. opracowanie wartości, które nie są liczbowe, np. w kolumnie okres w miesiącach występują liczne teksty "Okres zakończy się dnia: dd.mm.yyyy".
Przydadzą się tutaj funkcje VBA Mid, Split i ostatecznie DateSerial, oto przykład:
Function ConvertLastToDate(c As String, StartDate As Date)
Dim y, m, d, LastPiece As String
Dim WrdArray As String
Dim WordArray As Variant
'sprawdź czy termin realizacji jest wart numeryczną
If IsNumeric(c) = False Then
'odetnij datę z Data zakończenia 31.12.2014 *)
LastPiece = Mid(c, InStrRev(c, " ") + 1)
'podziel na kawałki oddzielone kropkami
WordArray = Split(LastPiece, ".")
d = WordArray(0)
m = WordArray(1)
y = WordArray(2)
'sklej w postaci daty excela
EndDate = DateSerial(CInt(y), CInt(m), CInt(d))
'odejmij od daty zakończenia i podaj w miesiącach
ConvertLastToDate = (Year(EndDate) - Year(StartDate)) * 12 + (Month(EndDate) - Month(StartDate))
ElseIf IsNumeric(c) = True Then
ConvertLastToDate = CInt(c)
End If
End Function
* Inne kombinacje odcinania lub pobierania odciętych kawałków tekstów z komórki:
Function GetLast(c As String)
GetLast = Mid(c, InStrRev(c, " ") + 1)
End Function
Function CutOffLast(c As String)
CutOffLast = Left(c, InStrRev(c, " ") - 1)
End Function
Function GetFirst(c As String)
GetFirst = Left(c, InStr(c, " ") - 1)
End Function
cdn.
