Question

如何在将所有文本格式化为大写时导入数据？

我没有尝试Destination:=Range(UCase("$A$1"))的错误，但是那没有用，并且我不想在导入文件后运行循环。

Option Explicit
Public Sub ImportData()
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Environ("USERPROFILE") & _
        "\Desktop\cisco.txt", Destination:=Range("$A$1") _
        )
        .Name = "ImportingFileName"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, xlTextFormat)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .WorkbookConnection.Delete
    End With
End Sub

Answer 1

这是您要尝试的吗？

Option Explicit

Dim ws As Worksheet

Sub ImportData()
    Set ws = ThisWorkbook.Worksheets.Add

    With ws.QueryTables.Add(Connection:= _
        "TEXT;" & Environ("USERPROFILE") & _
        "\Desktop\cisco.txt", Destination:=ws.Range("$A$1") _
        )
        .Name = "ImportingFileName"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, xlTextFormat)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .WorkbookConnection.Delete
    End With

    ChangeRngToUpperCase
End Sub

'~~> Function to Change an entire range to upper case without
'~~> looping through each cell
Sub ChangeRngToUpperCase()
    Dim lRow As Long, lCol As Long
    Dim tmpAr()
    Dim rng As Range

    With ws
        '~~> Find last row and last column
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                After:=.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

            lCol = .Cells.Find(What:="*", _
                After:=.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Column

            '~~> Indentify your range
            Set rng = .Range(.Cells(1, 1), .Cells(lRow, lCol))
            '~~> Convert entire range to upper case and store it in an array
            tmpAr = Evaluate("INDEX(UPPER(" & rng.Address(External:=True) & "),)")
            '~~> Tranfer data back to range
            rng = tmpAr
        End If
    End With
End Sub

如何在将文本格式化为大写时导入文本文件

1 个答案: