| |
もう一つ全く別の方法でも出来そうなので、テストしてみて下さい。
空白シートにクエリーテーブルを定義して、5行目から読み込みます。
Sub Txt_Query()
Dim MyR As Range, MyR2 As Range
Dim i As Long, FR As Long
Const MyF As String = _
"C:\Documents and Settings\User\My Documents\testA.txt"
'↑実際に読み込むテキストファイルのフルパスに変更
Application.ScreenUpdating = False
Cells.ClearContents
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyF, Destination:=Range("A1"))
.Name = "testA" '←これも当該テキストファイルの名前に変更
.FieldNames = False
.RefreshStyle = xlInsertDeleteCells
.AdjustColumnWidth = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 5
.TextFileParseType = xlDelimited
.TextFileConsecutiveDelimiter = True
.TextFileSpaceDelimiter = True
.Refresh BackgroundQuery:=False
.Delete
End With
With Range("A1", Range("A65536").End(xlUp)).Offset(, 255)
.Formula = _
"=IF(OR($A1=""{"",$A1=""}""),TRUE,IF($A1=""[ID]"",ROW(),""a""))"
.Value = .Value
Set MyR = .SpecialCells(2, 2).Offset(, -255)
Set MyR2 = .SpecialCells(2, 1).Offset(, -253)
End With
For i = 1 To MyR.Areas.Count
With MyR.Areas(i)
.Resize(, 2).Sort Key1:=.Range("B1"), Order1:=xlDescending, _
Header:=xlNo, Orientation:=xlSortColumns
MyR2.Areas(i).Resize(, .Count).Value = _
WorksheetFunction.Transpose(.Value)
End With
Next i
Range("A1", Range("A65536").End(xlUp)).Resize(, 256) _
.Sort Key1:=Columns(256), Order1:=xlAscending, Header:=xlNo, _
Orientation:=xlSortColumns
FR = WorksheetFunction.Match("a", Range("IV:IV"), 0)
Rows(FR & ":" & 65536).ClearContents
Range("IV:IV").ClearContents
Range("A:A").Delete xlShiftToLeft
Application.ScreenUpdating = True
Set MyR = Nothing: Set MyR2 = Nothing
With ThisWorkbook
.Names(.Names.Count).Delete
End With
End Sub
|
|
Kein
- 07/1/26(金) 20:15 -
