| |
▼inoue さん：
>ここでヒントは差し上げましたが１からやり直しですか？
>何も進んでいないのですか？
お世話になります。
一応できるところまでやってみましたが、できればご教授下さい。
マクロを記録したりして、下記のところまで、テキストをインポートできましたが、
F1という注文NOの最後の場所から３０台分のF１の注文No分を省く部分をどういれて
よいかわかりかねております。
すみませんが、よろしくお願い致します。
Sub インポート() 'データインプット
' データのインポート Macro
Dim OpenFile As String
Dim TBL() As Long, DataCnt As Long, STRow As Long
Dim ReadDete As String, DData As Variant
OpenFile = Application.GetOpenFilename("テキストファイル (*.txt;*.dat), *.txt;*.dat")
If OpenFile = "False" Then
End
End If
Stime = Now() '現時点
Open OpenFile For Input As #1 '1レコード毎読込み
Line Input #1, ReadDete '読込んだレコードをReadDeteに保存
DataCnt = DataCnt + 1 '最終行を検索
Do Until EOF(1)
Line Input #1, DData
DataCnt = DataCnt + 1
Loop
Close #1
CNT = 0: WFlg = 0
Range("A1000").Value = ReadDete '1レコードの長さを計測し貼り付け保存
For i = 1 To Len(ReadDete)
Range("A3").Value = Mid(ReadDete, i, 1)
If Mid(ReadDete, i, 1) = "," And (WFlg = 0 Or WFlg = 2) Then
CNT = CNT + 1
ReDim Preserve TBL(1 To CNT)
If WFlg = 0 Then
TBL(CNT) = 1
Else
TBL(CNT) = 2
End If
WFlg = 0
カンマ数 = カンマ数 + 1
ElseIf Mid(ReadDete, i, 1) = Chr(34) And WFlg = 0 Then
WFlg = 1
ElseIf Mid(ReadDete, i, 1) = Chr(34) And WFlg = 1 Then
WFlg = 2
ElseIf Mid(ReadDete, i, 1) = "," And WFlg = 2 Then
WFlg = 0
カンマ数 = カンマ数 + 1
ElseIf i = Len(ReadDete) Then
CNT = CNT + 1
ReDim Preserve TBL(1 To CNT)
TBL(CNT) = 1
End If
Next
Range("B2").Resize(, カンマ数 + 1).Value = TBL
STAdd = StartAddSet
huhu = Range(STAdd).Row
popo = (Range(STAdd).Row + DataCnt - 1)
yuio = Cells.Rows.Count - (Range(STAdd).Row + DataCnt - 1)
STRow = 1
If DataCnt > Cells.Rows.Count * 2 Then
MsgBox DataCnt & "以上は、このマクロでは無理です。"
End
ElseIf Cells.Rows.Count - (Range(STAdd).Row + DataCnt - 1) >= 0 Then
LPC = 1
Else
Ag = (Range(STAdd).Row + DataCnt) - Rows.Count
LPC = 2
End If
'End
For i = 1 To LPC
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & OpenFile, _
Destination:=Range(STAdd))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 9, 9, 9, 9, 9, 1, 9) '２は文字列、１は標準、９は削除
.TextFileFixedColumnWidths = Array(9, 6, 2, 10, 16, 22, 15, 10, 10, 6) 'セルの幅
.Refresh BackgroundQuery:=False
End With
If LPC = 2 And i = 1 Then
'3537
'STRow = DataCnt - (Range(STAdd).Row + DataCnt - 1) - Rows.Count
STRow = Rows.Count - Range(STAdd).Row + 1
AcShNam = ActiveSheet.Name
Worksheets.Add(After:=ActiveSheet).Name = AcShNam & "-2"
Application.DisplayAlerts = False
End If
Next
Application.DisplayAlerts = True
Erase TBL
End Sub
|
|
まさ〜る
- 06/1/24(火) 22:09 -
