アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

質問者からの補足コメント

  • こちらの都合を勝手に決めつけていきなり文句とは不愉快です。通報しました。
    実際、このような投稿でしっかり回答している投稿を私はみてます。
    その言い分なら管理人にいってみては?

      補足日時:2017/12/05 13:37

A 回答 (1件)

ふざけちゃいけません。


人の労力をそんな使い方するのは失礼極まりない。
どうせどっかで拾って来たコードを貼り付けて解説しろなんて、なんのつもりですか?
全部わからないなら説明したって貴方には理解出来る事は有りません。
部分的に分からないなら分かる可能性はあるけど、逆に何でわからないところだけ聞かないのって話し。
    • good
    • 3

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!