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で質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) InputBoxでキャンセルボタンを押したらファイル自体を閉じたい 3 2022/07/23 17:52
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) 数字が「0」の列を削除するため、下記のコードを実行しましたが、コンパイルエラーSubまたはFunct 3 2022/12/04 00:00
- Visual Basic(VBA) VBA 請求書自動作成 3 2022/04/24 01:58
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで、抽出したデータだ...
-
X-Ripperというフリーウェアに...
-
エクセル VBA メール本文に指定...
-
コンボボックス全ての値を取得...
-
COUNTIFのやり方を教えてくださ...
-
AccessのWHERE句において、変数...
-
未審査請求包袋抽出表作成とは...
-
エクセルで色の付いたセルを抽...
-
PDFファイルから特定の文字を検...
-
Excel 文字列から6桁の数値の抽出
-
Photoshop CS2で抽出の際輪郭が...
-
Access 抽出条件
-
Access2010クエリ抽出条件(Like)
-
【エクセルVBA】 A1セルを参照...
-
アクセスのテキストボックスでO...
-
脂質抽出におけるクロロホルム...
-
access クエリ yes/no型のクエ...
-
awkでスラッシュがある動的変数...
-
【AccessVBA】レコードセットOp...
-
PCゲーム 音声 画像 抽出方法
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで、抽出したデータだ...
-
「パラメータが少なすぎます。3...
-
PDFファイルから特定の文字を検...
-
AccessのWHERE句において、変数...
-
エクセルで色の付いたセルを抽...
-
ACCESSのクエリー抽出条件にIIF...
-
【AccessVBA】レコードセットOp...
-
Excel 文字列から6桁の数値の抽出
-
PDFファイル/抽出許可され...
-
X-Ripperというフリーウェアに...
-
アクセス 同じフィールド(テキ...
-
未審査請求包袋抽出表作成とは...
-
access クエリ yes/no型のクエ...
-
ACCESS クエリ 条件以外のレ...
-
血から鉄って作れないですか?
-
エクセル関数で住所から丁目番...
-
Access チェックボックスを利用...
-
COUNTIFのやり方を教えてくださ...
-
エクセル VBA メール本文に指定...
-
Accessの選択クエリの抽出条件...
おすすめ情報
こちらの都合を勝手に決めつけていきなり文句とは不愉快です。通報しました。
実際、このような投稿でしっかり回答している投稿を私はみてます。
その言い分なら管理人にいってみては?