2017-09-18 21 views
1

毎日レポートを取得して約8500行になります。手動でやっていることを行うマクロを作成しようとしています。レポートの問題は、すべての行が同じ形式ではないことです(行1:数値、テキスト、テキスト、数値、行2:テキスト、数値、数値、テキスト)。2つのファイルを比較して異なる行を出力します

新しいファイルと古いファイルを比較し、新しい違いを出力したいと考えています。私は2つのファイルを実行するマクロを取得することができますが、それは異なるとして任意の行のフラグを立てていませんが、私は彼らが知っている。より高速なテストを実行するために使用されている

Sub test() 

Dim yesterdayFile As String 
Dim todayFile As String 

yesterdayFile = Application.GetOpenFilename() 
todayFile = Application.GetOpenFilename() 
Dim yesterdayLine As String 
Dim todayLine As String 
Dim txt As String 
Dim i, j, k, sameLine As Integer 
Dim wkbTemp As Workbook 
i = 1 
j = 1 
k = 1 
sameLine = 0 


Open yesterdayFile For Input As #1 
Do Until EOF(1) 
    sameLine = 1 'reset write operator 
    Open todayFile For Input As #2 
Line Input #1, yesterdayLine 
    Do Until EOF(2) 
     Line Input #2, todayLine 
     If StrComp(yesterdayLine, todayLine) = 0 Then 'compare lines in files if same then flag write operator to 1 
      sameLine = 1 
     End If 
     j = j + 1 'inner loop counter 
    Loop 
If sameLine = 0 Then 'if write operator is not active then output line 
    Cells(i, 1) = yesterdayLine 
    i = i + 1 'counter for cells 
End If 
Close #2 
k = k + 1 'outer loop counter 
Loop 

'test line to see if its eof 
Cells(1, 10) = i 
Cells(2, 10) = j 
Cells(3, 10) = k 

Close #1 



End Sub 

テストファイル:

昨日のファイル:

10001,April,Apple 
10002,Book,Bush 
10004,Dog,Days 
10006,Free,Food 
10008,Happy,Help 
10009,Ikky,Icing 
10010,Jamming,Jupiter 

今日ファイル:

10001,April,Apple 
10002,Book,Bush 
10003,Cat,Cattle 
10004,Dog,Days 
10005,Echo,Eggg 
10006,Free,Food 
10007,Good,Game 
10008,Happy,Help 
10009,Ikky,Icing 
10010,Jamming,Jupiter 

注:実際のデータではありませんがあります「一意のIDフィールド」

カウンタが正しい番号で終了するので、再帰を実行することがわかります

EDIT:これは他の言語でも簡単に行うことができますが、私のワークターミナルからExcel vbaにしかアクセスできず、ネットワークからファイルを取得できません。

+0

正確なセルは異なる必要がありますか?または、行の順序が異なるが、値が同じであればOKですか? – danieltakeshi

+0

入力行を直接セルではなくファイルからテストしています。CSVファイルなので、行全体が「テキスト」としてリストされます。 "number" | "number" | "テキスト"。デリミタリングは、私が実際に出力するラインを得ることができるときに取り組むべき問題です。 – Nealin

+0

私はあなたが[配列](https://stackoverflow.com/questions/34563525/improving-the-performance-of-for-loop/34564306#34564306)で作業し、両方の多次元配列に一致しなければならないと思います。または、セルのcsvデータを入力してスプレッドシート内で一致させることもできます。 [メソッドのパフォーマンス](https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/) – danieltakeshi

答えて

0

多くの試行錯誤の後、私は自分の質問に答えました。すべての回答をありがとうございますが、72百回の反復から3bilに移行することはオプションではありませんでした。私のコードは、これは、.txtファイルや.csvファイル上で動作し、任意のセルに書き込む前に直接入力行を比較し

Sub test() 
'Freeze window 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

'open files to edit 
Dim fileA, fileB As String 
fileA= Application.GetOpenFilename() 
fileB = Application.GetOpenFilename() 

'setting variables 
Dim lineA, lineB, DQ As String 'read in lines and double quote  variables 
Dim i, sameLine As Integer 'row counter and testing(could have used boolean?) 
Dim newLine 'object creation for array of line 
i = 1 
DQ = Chr(34) 'character 34 is " 

Open fileA For Input As #1 'open file 1 for append 
Do Until EOF(1) 'Outter loop to run through file 1 
    sameLine = 0 'reset write operator 
    Open fileB For Input As #2 'open file 2 for append 
    Line Input #1, lineA'read in line from file 1 
    Do Until EOF(2) 'inner loop to run through file 2 
     Line Input #2, lineB 'read in line from file 2 
     If StrComp(lineA, lineB) = 0 Then 'compare lines in files if same then flag write operator to 1 
      sameLine = 1 
     End If 
    Loop 
    If sameLine = 0 Then 'if write operator is not active then output line 
     count = Len(lineA) - Len(Replace(lineA, "|", ""))  'count number of columns needed for output 
     lineA= Replace(lineA, DQ, "") 'removing all double  quotes from line 
     newLine = Split(lineA, "|") 'spliting line into object with | as delimiter 
     For counter = 1 To count 'placing line in row 
      Cells(i, counter) = newLine(counter - 1) 
     Next counter 
     i = i + 1 'counter for cells 
    End If 
Close #2 
Loop 
Close #1 
'unfreezing window 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 
End Sub 

ように見えてしまった何

。私の問題は、各行の終わりにタイムスタンプが付いていて、修正するためにいくつかの行を追加したためにユニークでした。

0

私が理解していれば、古いものと新しいものの両方で使用される4つのフィールドがあります。それぞれのwbの行数/タスク数は同じです。それはかなりありませんが、あなたはに似て評価することができます:昨日のワークブックのために最新のワークブック、およびwbOldとSHOLDを使用して示すためにwbNewとshNewを使用して

Dim i as Long, j as Long, k as Long, l as Long, m as Long 

If wbNew.shNew.Cells(i, 1).Value = wbOld.shOld.CellS(i,1).Value OR wbNew.shNew.Cells(i, 1).Value = wbOld.shOld.CellS(i,2).Value OR wbNew.shNew.Cells(i, 1).Value = wbOld.shOld.CellS(i,3).Value OR wbNew.shNew.Cells(i, 1).Value = wbOld.shOld.CellS(i,4).Value OR Then 
    j=1 
End If 

If wbNew.shNew.Cells(i, 2).Value = wbOld.shOld.CellS(i,1).Value OR wbNew.shNew.Cells(i, 2).Value = wbOld.shOld.CellS(i,2).Value OR wbNew.shNew.Cells(i, 2).Value = wbOld.shOld.CellS(i,3).Value OR wbNew.shNew.Cells(i, 2).Value = wbOld.shOld.CellS(i,4).Value OR Then 
    k=1 
End If 

If wbNew.shNew.Cells(i, 3).Value = wbOld.shOld.CellS(i,1).Value OR wbNew.shNew.Cells(i, 3).Value = wbOld.shOld.CellS(i,2).Value OR wbNew.shNew.Cells(i, 3).Value = wbOld.shOld.CellS(i,3).Value OR wbNew.shNew.Cells(i, 3).Value = wbOld.shOld.CellS(i,4).Value OR Then 
    l=1 
End If 

If wbNew.shNew.Cells(i, 4).Value = wbOld.shOld.CellS(i,1).Value OR wbNew.shNew.Cells(i, 4).Value = wbOld.shOld.CellS(i,2).Value OR wbNew.shNew.Cells(i, 4).Value = wbOld.shOld.CellS(i,3).Value OR wbNew.shNew.Cells(i, 4).Value = wbOld.shOld.CellS(i,4).Value Then 
    m=1 
End If 

If (i+j+k+l)=4 Then 
    wbNew.shNew.Rows(i).Interior.Color=2 
End If 

j=0 
k=0 
l=0 
m=0 

。これはすべてループ内にあり、最後の行を見つける必要があります。あなたは行ごとにユニークな何かを持っていたので、できれば

z = Application.Match(wbNew.shNew.Cells(i,1),wbOld.sheOld.Columns(1)).Row 
If wbNew.shNew.Cells(i,1).Value = wbOld.shOld.Cells(z, 1).Value OR wbNew.shNew.Cells(i,1).Value = wbOld.shOld.Cells(z, 2).Value OR wbNew.shNew.Cells(i,1).Value = wbOld.shOld.Cells(z, 3).Value OR wbNew.shNew.Cells(i,1).Value = wbOld.shOld.Cells(z, 4).Value Then 
    j=1 
End If 

これはケースより次のようになります。あなたはまた、そのようなことを、()、またはマッチ()の検索に使用するアプローチを取ることができる


zを見つけたら、比較を行うには1つのワークブック/シートをループするだけです。これは役立つかもしれない

Dim r as long, c as Long 

For r = 1 to LR 
    For c = 1 to LC 
     If Cells(r, c).Value = "Moo" Then 
      If Cells(r, c).Interior.Color <> 2 Then 
       Cells(r, c).Interior.Color=2 
      End If 
     End If 
    Next c 
Next r 


編集:両方の列と行(ネストされたループ)をループし、trueの場合はフラグを細胞内部マーキングの例を追加

Dim y as Variant 

y = wbNew.shNew.Cells(r, c).Value 
のような次元で作業したいセルを作成します。

これで、編集が簡単になります。

+0

サンプルコードはほんの数フィールドです実際のデータの範囲は19〜42フィールドです。だから、これを42フィールドに使うのはかなり大変なので、私は入力ラインを直接テストしていたのです。 – Nealin

+0

@Nealinにはページにヘッダーがありますか?あなたが扱う正確な細胞を示すことができるように、それを簡単にするでしょう。 – Cyril

+0

残念ながら、ファイルは約8つの別個のテーブルを含むCSVファイルなので、ヘッダーはファイルの全長にわたって機能しません。 – Nealin

関連する問題