[VAB] txt reader -from Chirstina

最新推荐文章于 2024-04-24 09:45:08 发布

conh22

最新推荐文章于 2024-04-24 09:45:08 发布

阅读量944

点赞数

分类专栏： VBA-Excel 文章标签： integer string function input output date

本文链接：https://blog.csdn.net/conh22/article/details/4715951

版权

VBA-Excel 专栏收录该内容

3 篇文章 0 订阅

订阅专栏

Private Sub cmdImport_Click()

Dim FldName() As String, FldStart() As Integer, FldEnd() As Integer, FldType() As String, _
FldFmt() As String, FldOFmt() As String, FldNoMulti() As String
Dim wkbk As Workbook, shtSetup As Worksheet, shtDef As Worksheet, shtOutput As Worksheet
Dim last_row As Integer, totfield As Integer, i As Integer, j As Integer
Dim filenm As String

    Set wkbk = ThisWorkbook
    Set shtSetup = wkbk.Worksheets("Setup")
    Set shtDef = wkbk.Worksheets("Definition")
    Set shtOutput = wkbk.Worksheets("Output")
    'clear previous content
    shtOutput.Cells.ClearContents

    last_row = shtDef.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ReDim FldName(last_row - 2), FldStart(last_row - 2), FldEnd(last_row - 2), _
           FldType(last_row - 2), FldFmt(last_row - 2), FldOFmt(last_row - 2), FldNoMulti(last_row - 2)
    totfield = 0
    For i = 0 To last_row - 2
        If shtDef.Cells(i + 2, 8) = "Y" Then
            FldName(totfield) = shtDef.Cells(i + 2, 1)
            FldStart(totfield) = shtDef.Cells(i + 2, 2)
            FldEnd(totfield) = shtDef.Cells(i + 2, 3)
            FldType(totfield) = shtDef.Cells(i + 2, 4)
            FldFmt(totfield) = shtDef.Cells(i + 2, 5)
            FldOFmt(totfield) = shtDef.Cells(i + 2, 6)
            FldNoMulti(totfield) = shtDef.Cells(i + 2, 7)
            shtOutput.Cells(1, totfield + 1) = FldName(totfield)
            totfield = totfield + 1
        End If
    Next i

    filenm = shtSetup.Range("C3")
    Open filenm For Input As #1
    j = 1
    Do While Not EOF(1)
        Line Input #1, tmpstr
        j = j + 1
        For i = 0 To totfield - 1
            tmpFld = Mid(tmpstr, FldStart(i), FldEnd(i) - FldStart(i) + 1)
            If FldType(i) = "Date" And Not (FldFmt(i) = "") Then
                shtOutput.Cells(j, i + 1) = fmtDate(tmpFld, Trim(FldFmt(i)))
                If FldOFmt(i) = "" Then
                    shtOutput.Cells(j, i + 1).NumberFormat = "MM/DD/YYYY"
                Else
                    shtOutput.Cells(j, i + 1).NumberFormat = FldOFmt(i)
                End If
            ElseIf FldType(i) = "Number" Then
                If FldOFmt(i) = "" Then FldOFmt(i) = "General"
                shtOutput.Cells(j, i + 1).NumberFormat = FldOFmt(i)
                If FldNoMulti(i) <> "" Then
                    shtOutput.Cells(j, i + 1) = CDbl(tmpFld) * CDbl(FldNoMulti(i))
                Else
                    shtOutput.Cells(j, i + 1) = tmpFld
                End If
            Else
                shtOutput.Cells(j, i + 1) = tmpFld
            End If
        Next i
        Debug.Print "importing loan " & j
    Loop
    Close #1
    MsgBox "done"

End Sub

'======================================================

Function fmtDate(ByVal txtinput As String, ByVal fmt As String) As String
Dim strDay As String, strMonth As String, strYear As String
Dim intDay As Integer, intMonth As Integer, intYear As Integer
    If (Trim(txtinput) = "") Or (Trim(txtinput) = "0") Then
        fmtDate = ""
        Exit Function
    End If

    intMonth = InStr(1, fmt, "MM")
    If intMonth > 0 Then
        strMonth = Trim(Mid(txtinput, intMonth, 2))
        If Left(strMonth, 1) = "0" Then strMonth = Right(strMonth, 1)
    Else
        strMonth = "1"
    End If

    intDay = InStr(1, fmt, "DD")
    If intDay > 0 Then
        strDay = Trim(Mid(txtinput, intDay, 2))
        If Left(strDay, 1) = "0" Then strDay = Right(strDay, 1)
    Else
        strDay = "1"
    End If

    intYear = InStr(1, fmt, "YY")
    If intYear > 0 Then
        strYear = "20" & Mid(txtinput, intYear, 2)
    ElseIf InStr(1, fmt, "YYYY") > 0 Then
        strYear = Mid(txtinput, intYear, 4)
    Else
        strYear = Format(Now(), "YYYY")
    End If
    fmtDate = strMonth & "/" & strDay & "/" & strYear

End Function