Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


47673 / 76732 ←次へ | 前へ→

【34009】Re:デキストデータの取込み時、条件にて必要データのみを読む込むには?
質問  まさ〜る  - 06/1/24(火) 22:09 -

引用なし
パスワード
   ▼inoue さん:
>ここでヒントは差し上げましたが1からやり直しですか?
>何も進んでいないのですか?
お世話になります。
一応できるところまでやってみましたが、できればご教授下さい。

マクロを記録したりして、下記のところまで、テキストをインポートできましたが、
F1という注文NOの最後の場所から30台分のF1の注文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) '2は文字列、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

0 hits

【34003】デキストデータの取込み時、条件にて必要データのみを読む込むには? まさ〜る 06/1/24(火) 20:12 質問
【34007】Re:デキストデータの取込み時、条件にて必... inoue 06/1/24(火) 21:50 発言
【34009】Re:デキストデータの取込み時、条件にて必... まさ〜る 06/1/24(火) 22:09 質問
【34010】Re:デキストデータの取込み時、条件にて必... inoue 06/1/24(火) 22:18 発言
【34011】Re:デキストデータの取込み時、条件にて必... まさ〜る 06/1/24(火) 22:44 質問
【34014】Re:デキストデータの取込み時、条件にて必... inoue 06/1/25(水) 0:10 発言

47673 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free