Czyszczenie danych skopiowanych do excela.

1. Czy wszystkie daty i wartości są rzeczywiście datami (czy też ciągami tekstowymi?) . Zawsze sprawdzałem to stawiając dodatkową kolumnę z formuła istext albo isnumber. Tym razem dla szybkiego sprawdzenia stosuję np. =SUMPRODUCT(--(ISTEXT(AI3:AI109)))  - która zwróci info w ilu przypadkach w komórkach wystąpiły śmieci.
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.