Ako opraviť dátumy v pracovnom hárku programu Excel pomocou VBA

Ako často dostaneme dátumy v tabuľkách dodaných k nám 12.26.2016 alebo 26/12/2016 (formát UK), len aby sme povedali, že dátum je neplatný alebo nie je 26. mesiac? Tento článok skúma opravenie dátumov pomocou VBA pomocou funkcií TRIM, LEFT, RIGHT a MID.

V článku sa predpokladá, že čitateľ má zobrazenú pásku pre vývojárov a je oboznámený s editorom VBA. Ak nie, navštívte Google kartu „Vývojár Excel“ alebo „Okno kódu Excel“.

XLSM v tomto cvičení je možné stiahnuť tu.

Nie náš problém!

Najlepšie vyriešite problém pri zdroji. Avšak v tomto prípade nemôže nijaké presvedčenie presvedčiť mzdové oddelenie, že 12.26.1994. XNUMX. XNUMX nie je platným dátumom (pokiaľ to nie je nakonfigurované v ovládacom paneli počítača pre niektoré východoeurópske krajiny).

V skutočnosti môžeme dokázať, že to nie je strojovo čitateľné. Napríklad pridanie 7 dní k dátumu:

"=01.01.2017 + 7" = #VALUE. 

"=2017.01.01 + 7" = #VALUE.

keďže…

"=2017-01-01 + 7" = 2017/01/08.

Predpokladajme, že naznačujú, že to nie je ich problém.

Formáty dátumu

Prvá vec, ktorú musíme zistiť, je, či je dátum v USA alebo v medzinárodnom formáte.

Náš príklad objasňuje, že sa zameriavame na použitie v USA, teda na MDY, a nie na medzinárodný formát DMY.

Len čo sme vytvorili zdroj, musíme zmeniť dátové formáty, aby ich Excel mohol chápať, či už na medzinárodnej úrovni, alebo v USA.

Najlepším spôsobom, ako to urobiť, je zmeniť dátum na rrrrmmdd, formát, ktorý nevyžaduje žiadnu kvalifikáciu.

Proces

Budeme prechádzať každým riadkom v dokumente a volať funkciu na „opravu“ dátumu podľa krajiny zdroja. Po oprave dátumu vypočítame vek zamestnanca.

Kódex

Skopírujte nasledujúci kód do nového modulu:

Option Explicit

Sub Main()
    Dim strNewFormat As String
    Dim strDate As String
    Sheets("Main").Range("B4").Select
    
    'Cycle through the sheet rows, using IDNumber as an anchor
    'to prevent a premature halt caused by a blank date of birth
    Do While ActiveCell > ""
        If ActiveCell.Offset(0, 2) > "" Then
            strDate = ActiveCell.Offset(0, 2)
            
            'Remove leading or trailing spaces
            strDate = Trim(strDate)
            
            'Call the function
            strNewFormat = ReformatDate(strDate, "USA")
            
            'Write the result from the function ReformatDate to a new column
            ActiveCell.Offset(0, 3) = strNewFormat
            
            'Determine age by subtracting the previous column from today's date
            ActiveCell.Offset(0, 4) = "=(NOW()-RC[-1])/365.25"
            
            'Convert to intger, thus lopping off decimal places
            ActiveCell.Offset(0, 4) = Int(ActiveCell.Offset(0, 4))
        End If
        Range("B" & ActiveCell.Row + 1).Select
    Loop
End Sub

Function ReformatDate(sDate As String, sSource As String)
    Dim yyyy, mm, dd As String
    yyyy = Right(sDate, 4)
    If sSource = "USA" Then
        mm = Left(sDate, 2)
        dd = Mid(sDate, 4, 2)
    Else
        mm = Mid(sDate, 4, 2)
        dd = Left(sDate, 2)
    End If
    ReformatDate = yyyy & "-" & mm & "-" & dd
End Function

Pridajte do formulára tlačidlo a priraďte ho k Sub Main.

Varovanie

Pred pridaním príliš zložitého kódu do modulu nezabudnite, že program Excel nie je pri vývoji hlavných aplikácií vždy stabilný a často nedokáže samotný poškodený kód obnoviť. Výsledkom môže byť poškodenie vašej jedinej kópie, pretože k poškodeniu dôjde v priečinku „Uložiť“.

Často zálohujte a opravte pomocou nástroja Poškodenie súboru programu Excel.

Úvod autora:

Felix Hooker je expert na obnovu dát v DataNumen, Inc., ktorá je svetovým lídrom v oblasti technológií obnovy dát, vrátane oprava rar poškodenie súboru a softvérové ​​produkty na obnovenie sql. Pre viac informácií navštívte www.datanumen. S