- 締切済み
エクセルでの一括データ処理(日付補完など)
エクセルによるデータ整理に手を焼いています。 データファイルを下記の様に変換して整理したいと考えています。 <元データ> [A] [B] [C] [D] … [1] 日付1 値1 日付2 値2 [2] 2007/12/7 1 2007/12/5 20 [3] 2007/12/9 4 2007/12/6 30 [4] 2007/12/11 3 2007/12/7 15 [5] 2007/12/10 10 [6] 2007/12/11 10 (A5:B6は空白です) <変換後データ> [A] [B] [C] [1]日付 値1 値2 [2]2007/12/5 NA 20 [3]2007/12/6 NA 30 [4]2007/12/7 1 15 [5]2007/12/8 NA NA [6]2007/12/9 4 NA [7]2007/12/10 NA 10 [8]2007/12/11 3 10 ("NA"部分は"0"あるいは空白で構いません) 同種の質問としてttp://okwave.jp/qa/q3911631.htmlを見つけましたが、 データファイルが大きいので、どうにかして一括で処理する方法を探しています。 やりたいことは、 (1)飛び飛びになっているデータの日付を補完し、 (2)日付を示す系列は1つだけに留めた上で日付に対応した値を並べる です。 マクロによる処理でも関数による処理でも何でも構いませんので、 どなたか解決策をご教示していただけると助かります。 なお、実際に処理したいデータファイルは1000列ほどで、500種類くらいの値とそれらに対応した日付が並んでいます。 使用しているエクセルは2007です。
- みんなの回答 (14)
- 専門家の回答
みんなの回答
- doara_2011
- ベストアンサー率59% (25/42)
まず入力データは 1.2行目から2列毎にデータが入っている 2.列ごとのデータの数は一定でない 3.1組分のデータは行方向に連続的に入力されている。(途中に空白のセルは存在しない) 4.上記のデータの組が500個位(*2で1000列)ある という前提でよろしいでしょうか? この前提でマクロを組んでみました。 なお、データのあるシートの名前を"input"、データの出力先シートの名前を"output"に してあります。実行する前にシートの名前の変更が必要です。また、例でNAと出力して いる個所は0を出力するようにしました。 Option Explicit Sub macro1() Dim m As Long, n As Long, i As Long, j As Long Dim ws1 As Worksheet Const rowFirst As Long = 2 ' データのある最初の行 Set ws1 = Worksheets("input") m = ws1.Cells(rowFirst, 1).End(xlToRight).Column - 1 Dim dtFirst As Date, dtLast As Date dtFirst = #12/31/9999# dtLast = #1/1/100# ' 期間の算出 Dim r As Variant Dim nRows() As Long, nCol As Long, k As Long k = 0 For i = 1 To m Step 2 n = ws1.Cells(rowFirst, i).End(xlDown).Row r = ws1.Range(ws1.Cells(rowFirst, i), ws1.Cells(n, i)) ReDim Preserve nRows(k) nRows(k) = n k = k + 1 For j = LBound(r, 1) To UBound(r, 1) If dtFirst >= r(j, 1) Then dtFirst = r(j, 1) If dtLast <= r(j, 1) Then dtLast = r(j, 1) Next j Next i nCol = k - 1 ' シートに書き出し Dim nDay As Long, strRange As String, val As Variant, ws2 As Worksheet Dim rng As Range nDay = DateDiff("d", dtFirst, dtLast) + 1 Set ws2 = Worksheets("output") With ws2 .Cells.ClearContents For i = rowFirst To nDay + rowFirst - 1 .Cells(i, 1) = dtFirst + i - rowFirst Next i .Cells(1, 1) = "日付" For j = 0 To nCol .Cells(1, j + 2) = "値" & CStr(j + 1) For i = rowFirst To nDay + rowFirst - 1 k = j * 2 Set rng = ws1.Range(ws1.Cells(rowFirst, k + 1), _ ws1.Cells(nRows(j), k + 2)) On Error Resume Next val = WorksheetFunction.VLookup(.Cells(i, 1), rng, 2, False) If Err.Number = 0 Then .Cells(i, j + 2) = val Else .Cells(i, j + 2) = 0 End If On Error GoTo 0 Next i Next j End With Set ws = Nothing End Sub 以上
- kagakusuki
- ベストアンサー率51% (2610/5101)
今仮に、<元データ>が入力されているシートがSheet1、<変換後データ>を表示させるシートがSheet2であるものとします。 まず、Sheet2のA2セルとA3セルの書式設定を[日付]として下さい。 次に、Sheet2のA2セルに、次の数式を入力して下さい。 =MIN(Sheet1!$A:$A,Sheet1!$C:$C) 次に、Sheet2のA3セルに、次の数式を入力して下さい。 =IF(A$2+ROW()-ROW(A$2)>MAX(Sheet1!$A:$A,Sheet1!$C:$C),"",A$2+ROW()-ROW(A$2)) 次に、Sheet2のB2セルに、次の数式を入力して下さい。 =IF($A2="","",IF(COUNTIF(Sheet1!$A:$A,$A2)=0,"NA",VLOOKUP($A2,Sheet1!$A:$B,2,FALSE))) 次に、Sheet2のC2セルに、次の数式を入力して下さい。 =IF($A2="","",IF(COUNTIF(Sheet1!$C:$C,$A2)=0,"NA",VLOOKUP($A2,Sheet1!$C:$D,2,FALSE))) 次に、Sheet2のB2~C2の範囲をコピーして、Sheet2のB3~C3の範囲に貼り付けて下さい。 次に、Sheet2のA3~C3の範囲をコピーして、同じ列の4行目以下に貼り付けて下さい。 以上です。
- KURUMITO
- ベストアンサー率42% (1835/4283)
元データがシート1に有るとして1行目には項目名で2行目から下方にデータがあるとします。 そこでお求めの表ですがA1セルに日付、B1セルに値1、C1セルに値2の項目名が有るとしたら初めにA2セルには次の式を入力して下方にオートフィルドラッグします。 =IF(MIN(MIN(Sheet1!A:A),MIN(Sheet1!C:C))+ROW(A1)-1>MAX(MAX(Sheet1!A:A),MAX(Sheet1!C:C)),"",MIN(MIN(Sheet1!A:A),MIN(Sheet1!C:C))+ROW(A1)-1) セルの表示形式は日付にします。 B2セルには次の式を入力してC2セルまでオートフィルドラッグしたのちに下方にもオートフィルドラッグします。 =IF($A2="","",IF(AND(COLUMN(A1)=1,COUNTIF(Sheet1!$A:$A,$A2)>0),INDEX(Sheet1!$B:$B,MATCH($A2,Sheet1!$A:A,0)),IF(AND(COLUMN(A1)=2,COUNTIF(Sheet1!$C:$C,$A2)>0),INDEX(Sheet1!$D:$D,MATCH($A2,Sheet1!$C:$C,0)),"")))
》 実際に処理したいデータファイルは1000列ほどで… 「1000列」は「1000行」の間違いと解釈すれば、 「変換後」のシートにおいて、次式で如何でしょ? B2: =VLOOKUP($A2,OFFSET(Sheet1!$A$1,1,(COLUMN(A2)-1)*2,10000,2),2,FALSE)
- 1
- 2
補足
回答ありがとうございます。 》 実際に処理したいデータファイルは1000列ほどで… 「1000列」で間違いありません。 実際は元データは以下の様な200行×1000列のファイルです。 日付や値の行数はバラバラで200行まであるものもあれば、5行程度しかないものもあります。また、日付は飛び飛びの値になっています。 [A] [B] [C] [D] … [ALK] [ALM] [1]日付1 値1 日付2 値2 日付500 値500 [2] [3] … [200] (A2:ALM200は省略)