Sub test()
'
'A列の商品抽出
Application.ScreenUpdating = False
Dim fn As String, a, Dest As String, myDir As String, dic As Object
Dim x, myCode As String, myIndex, i As Long, n As Long
fn = Application.GetOpenFilename("CSVFiles,*.csv")
If fn = "False" Then Exit Sub
With CreateObject("Scripting.FileSystemObject")
x = Split(.OpenTextFile(fn).ReadAll, vbCrLf)
myDir = .GetFile(fn).Path & "\"
fn = .GetBaseName(fn) & "." & .GetExtensionName(fn)
End With
Dest = Application.GetSaveAsFilename(Format$(Date, _
"yyyy_mm_dd_") & fn, "CSVファイル,*.csv")
myCode = InputBox("条件項目名の入力", , "商品コード")
If myCode = "" Then Exit Sub
myIndex = GetCodeIndex(x, myCode, ",")
If IsError(myIndex) Then
MsgBox "[" & myCode & "] は有効な項目ではありません。", 16
Exit Sub
End If
If Dest = "False" Then Exit Sub
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
With Sheets("sheet1")
a = .Range("a1", .Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
End With
For i = 1 To UBound(a, 1)
dic(CStr(a(i, 1))) = Empty
Next
For i = 0 To UBound(x)
If x(i) <> "" Then
If i < myIndex(1) Then
x(i) = vbNullString
ElseIf i > myIndex(1) Then
If dic.exists(Replace(Split(x(i), ",")(myIndex(0)), """", "")) Then
x(i) = vbCrLf & x(i): n = n + 1
Else
x(i) = vbNullString
End If
End If
End If
Next
Open Dest For Output As #1
Print #1, Join(x, "")
Close #1
MsgBox n & " 件抽出"
End Sub
Function GetCodeIndex(x, myCode As String, delim As String)
Dim i As Long, ii As Long, y, flg As Boolean
Dim rowInd As Long, ColInd As Long
For i = 0 To UBound(x)
If x(i) <> "" Then
y = Split(x(i), delim)
For ii = 0 To UBound(y)
If LCase$(Replace(y(ii), """", "")) = LCase$(myCode) Then
rowInd = i: ColInd = ii: flg = True: Exit For
End If
Next
End If
If flg Then Exit For
Next
If flg Then
GetCodeIndex = Array(ColInd, rowInd)
Else
GetCodeIndex = CVErr(2042)
End If
End Function
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで、抽出したデータだ...
-
コンボボックス全ての値を取得...
-
未審査請求包袋抽出表作成とは...
-
【AccessVBA】レコードセットOp...
-
AccessのWHERE句において、変数...
-
Accessの選択クエリの抽出条件...
-
access クエリ yes/no型のクエ...
-
Access2003 式ビルダでのLike...
-
エクセルで色の付いたセルを抽...
-
Access クエリ抽出条件の「Bet...
-
【Access】条件未入力時、全件...
-
PDFファイルから特定の文字を検...
-
Excel 文字列から6桁の数値の抽出
-
【エクセルVBA】 A1セルを参照...
-
エクセル関数で住所から丁目番...
-
X-Ripperというフリーウェアに...
-
エクセル VBA メール本文に指定...
-
2段層化標本抽出とは・・・
-
Accessで複数のクエリの抽出条件
-
アクセス 同じフィールド(テキ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで、抽出したデータだ...
-
「パラメータが少なすぎます。3...
-
PDFファイル/抽出許可され...
-
X-Ripperというフリーウェアに...
-
【AccessVBA】レコードセットOp...
-
未審査請求包袋抽出表作成とは...
-
PDFファイルから特定の文字を検...
-
ACCESSのクエリー抽出条件にIIF...
-
エクセル関数で住所から丁目番...
-
access クエリ yes/no型のクエ...
-
Excel 文字列から6桁の数値の抽出
-
Access チェックボックスを利用...
-
AccessのWHERE句において、変数...
-
アクセス 同じフィールド(テキ...
-
エクセル VBA メール本文に指定...
-
エクセルで色の付いたセルを抽...
-
PCゲーム 音声 画像 抽出方法
-
Accessの選択クエリの抽出条件...
-
ACCESSのフォームからレポート...
-
アクセスのテキストボックスでO...
おすすめ情報
こちらの都合を勝手に決めつけていきなり文句とは不愉快です。通報しました。
実際、このような投稿でしっかり回答している投稿を私はみてます。
その言い分なら管理人にいってみては?