1349841076 質問です

添付のマクロを参照して
マクロ実行用エクセルにsheet1からn個の複数SheetにデータがA列からT列まで
ありますデータは1行目からです
A列を対象キーとします重複はありませんA列のデータは文字列です

C:\test\のホルダーにCSVファイルが1個あります
A列からT列まで1行目からデータがあります、B列は空白です

A列を対象キーとします重複はありませんA列のデータは文字列です

このA列のデータと同じものが実行用データの複数sheetのA列に無い場合は
CSVファイルのB列に1をつけます、あれば空白で可(重複データと判断)

処理速度はできるだけ早くおねがいします。
以上の作業をマクロでお願いします
よろしくお願いします

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2012/10/10 12:51:16
  • 終了:2012/10/11 17:43:01

ベストアンサー

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982012/10/10 21:42:45

ポイント200pt
Sub main()
Dim p As String
'対象フォルダを指定してください。
'このフォルダに この実行用のブックは 入れないでください。

p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します。
Call jikkou(p, "csv")

End Sub


Sub jikkou(p As String, s As String)

Dim bk() As String
Application.DisplayAlerts = False
    
f = Dir(p & "*." & s, vbNormal)

Do While f <> ""
    k = 0
    ReDim bk(k)
 
    ch1 = FreeFile
    Open p & f For Input As #ch1
 
    Do While Not EOF(ch1)           'ファイルの終端かどうかを確認します
        Line Input #ch1, textline   'データ行を読み込みます
        ReDim Preserve bk(k)
        bk(k) = textline
        k = k + 1
    Loop
    Close #ch1
 
    ch2 = FreeFile
    Open p & f For Output As #ch2
    For i = 0 To k - 1
        textline = bk(i)
        dflg = 1
        ターゲット = ""
        If Left(textline, 1) = """" Then
            csvget = InStr(1, textline, """,")
            dflg = 0
            If csvget > 0 Then
                ターゲット = Right(Left(textline, csvget - 1), csvget - 1)
            End If
        Else
            csvget = InStr(1, textline, ",")
            If csvget > 0 Then
                ターゲット = Left(textline, csvget - 1)
            End If
        End If
        
        If ターゲット <> "" Then
            For Each sh In ThisWorkbook.Worksheets
                cnt = WorksheetFunction.CountIf(sh.Range("A:A"), ターゲット)
                If cnt > 0 Then Exit For
            Next sh
                
            If cnt = 0 Then
                If dflg = 0 Then
                    bb = Right(textline, Len(textline) - csvget - 1)
                    bc = InStr(1, bb, ",")
                    textline = Left(textline, csvget + 1) & "1" & Right(bb, Len(bb) - bc + 1)
                Else
                    bb = Right(textline, Len(textline) - csvget)
                    bc = InStr(1, bb, ",")
                    textline = Left(textline, csvget) & "1" & Right(bb, Len(bb) - bc + 1)
                End If
            End If
            
        End If
        
        Print #ch2, textline       'データの書き込みをします
    Next i
    Close #ch2
 
    f = Dir
Loop

Application.DisplayAlerts = True

End Sub

csvファイルは、フォルダ内にあるものすべて処理します。

重複ありの場合は、元のままで何もしていません。
重複なしの場合のみ1をセットしています。

他2件のコメントを見る
id:inosisi4141

ありがとうございます
CSVの内容で最初の項目(1行目)に”が含まない項目をあらかじめ作っておいて
その下2行目から対象データをセットしてマクロを実行することで良いでしょうか

2012/10/11 19:42:10
id:taknt

その下2行目以降もすべて 最初の項目に " を 含まないということです。
それで プログラムを 修正して どれぐらい速くなるかですね。
ま、そんなには 速くはならないとは思いますが・・・。

ちなみに 今は 処理時間は どれぐらいかかってますか?

2012/10/11 19:52:16

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません