左の様な元データから右の様に日付を抽出したいです。

*以下、元データの説明
・データは月によって量が違います。
・データはさらに別の元データ(1月~12月まである)から月ごとにシートに分けて抽出済みです。
・データの値は必ず"1"が入ります。
・データ1,2,3いずれにもデータが無ければ日付はありません。
・同じ日に同じデータに値が入る事もあります。(元データの3行目と4行目のデータ3)
・同じ日に複数のデータに値が入る事もあります。(元データ3行目のデータ2とデータ3)

*以下、やりたい事
・抽出シートに1,2,3それぞれに値がある日の日付を抽出したい。
・データに値が無しの行は無視(抽出せずに詰める)する。
・同じ日に同じデータがある時はその数分日付を抽出。(抽出データのデータ3の2行目、3行目)

 要するに特定の列に値があればC列の値を抽出したいが、値の無い行は無視をする(抽出データには空欄を入れるのではなく上に詰める)です。

以上分かりづらい質問ですがお力添えお願いいたします。

「特定の列に値があれば日付を取得したい。(」の質問画像

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

  • どう思う?

    書き忘れていました。
    回答は関数でもマクロでもVBAでも可なのですが、VBAは勉強し始めたばかりでWebで誰かがした質問に対する答えの式をコピーで拝借し、自分の物に当てはめて書き換える(ダメなら色々と試行錯誤)程度のレベルですのであまり複雑な難しい式は理解出来ないかもしれません。

    また月ごとに抽出したデータは大元の1月~12月が入ったデータが更新されたらマクロにて都度更新しています。
    なので頻繁に書き換わり(一旦削除し、抽出し直し)ます。

    大元のデータはデータが増えてはいきますが削除や書き換わりはありませんので、そこから月ごとで質問のような事が出来れば理想なのですが、やる事が複雑になりそうなので質問の様な物になりました。

      補足日時:2017/07/13 12:14
  • へこむわー

    質問と関係無いですがNo.4のお礼文内でtom04さんのお名前を間違えてしまいました。
    大変失礼致しました。
    それと今回初めて「教えて!goo」での質問を利用したのでマナー違反や無礼な事があれば併せてこの場で謝罪いたします。

      補足日時:2017/07/13 18:16

A 回答 (4件)

#1です。



数式案をお勧めするつもりはないので別にいいのですが

> 教えて頂いた物はシートが表示された状態でCtrl+Shift+Enterという作業
> をしないといけない物ですよね?
違います。数式を確定する時の操作であって 利用者には無関係な話です。
どうしても嫌なら 名前定義してやれば済みます。

マクロでやるにしても

Sub Macro1()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim sht1Val As Variant, lr As Long
Dim i As Long, j As Long
Set sht1 = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")
Application.ScreenUpdating = False
With sht1
sht1Val = .Range("B2:F" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
End With
With sht2
.Range("A:D").ClearContents
.Range("A1").Value = sht1.Range("B1").Value
.Range("B1:D1").Value = sht1.Range("D1:F1").Value
For i = 1 To UBound(sht1Val)
For j = 3 To 5
If sht1Val(i, j) = 1 Then
lr = .Cells(Rows.Count, j - 1).End(xlUp).Row
.Cells(lr + 1, 1).Value = sht1Val(i, 1)
.Cells(lr + 1, j - 1).Value = sht1Val(i, 2)
End If
Next j
Next i
End With
Application.ScreenUpdating = False
Set sht1 = Nothing: Set sht2 = Nothing
End Sub
    • good
    • 0
この回答へのお礼

Ctrl+Shit+Enter理解しました!
tomo04さんの回答と共に試行錯誤しつつ自分に合っている方で色々試してみようと思います。

皆様に記して頂いた物を理解するのにいちいち調べつつなので時間はかかりますが今回の皆様の回答で自分の中で大分スキルが上がった感じがします。
解決の糸口も見えてきましたがまだまだ「もっとこんな簡単な方法があるよ!」のような回答を期待しつつ(甘い考えですみません)ベストアンサーの選択はもう少しだけ待って頂きたいと思います。

お礼日時:2017/07/13 17:51

No.2です。



投稿後気づいたのですが・・・
>・データはさらに別の元データ(1月~12月まである)から月ごとにシートに分けて抽出済みです。

すなわち、Sheet1には1か月分のデータだけしかないのですね?
そうであればかなり簡単にできます。

前回のコードはすべて消去し↓のコードにしてみてください。

Sub Sample2()
Dim i As Long, j As Long, lastRow As Long
Dim myMax As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(wS.Cells(2, "A"), wS.Cells(lastRow, "D")).ClearContents
End If
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
For j = 4 To 6
If .Cells(i, j) <> "" Then
wS.Cells(i, "A") = .Cells(i, "B")
wS.Cells(i, j - 2) = .Cells(i, "C")
End If
Next j
Next i
lastRow = wS.UsedRange.Rows.Count
On Error Resume Next
Range(wS.Cells(2, "A"), wS.Cells(lastRow, "D")).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
For j = 2 To 4
myMax = WorksheetFunction.Max(myMax, wS.Cells(Rows.Count, j).End(xlUp).Row)
Next j
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > myMax Then
Range(wS.Cells(myMax + 1, "A"), wS.Cells(lastRow, "A")).ClearContents
End If
End With
MsgBox "完了"
End Sub

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 0
この回答へのお礼

その後も気にかけてくださりありがとう御座います。
これなら私にも1つずつですが調べながらなんとかギリギリ理解出来そうな感じです。
まだ(質問用に用意した画像の物じゃなく)本来のブック内では試行錯誤中ですが筋道が見えた気がします。

お礼日時:2017/07/13 17:42

こんにちは!



VBAでの一例です。
Sheet2の表示は月だけになっているので、Sheet1は1年分のデータという前提です。

尚、Sheet3を作業用のシートとして使っていますので、Sheet3は全く使用していない状態にしておいてください。
標準モジュールです。

Sub Sample1()
Dim i As Long, j As Long, k As Long, lastRow As Long
Dim myMax As Long, wS2 As Worksheet, wS3 As Worksheet
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
Application.ScreenUpdating = False
lastRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(wS2.Cells(2, "A"), wS2.Cells(lastRow, "F")).ClearContents
End If
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("G:G").Insert
.Range("G1") = "ダミー"
Range(.Cells(2, "G"), .Cells(lastRow, "G")).Formula = "=IF(COUNT(D2:F2),B2,"""")"
.Range("G:G").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
wS3.Range("C:G").ClearContents
If wS3.Cells(i, "A") <> "" Then
.Range("A1").AutoFilter field:=7, Criteria1:=wS3.Cells(i, "A")
.Range("B:F").SpecialCells(xlCellTypeVisible).Copy wS3.Range("C1")
For k = 2 To wS3.Cells(Rows.Count, "C").End(xlUp).Row
For j = 5 To 7
If wS3.Cells(k, j) <> "" Then
wS3.Cells(k, j) = wS3.Cells(k, "D")
End If
Next j
Next k
lastRow = wS3.Cells(Rows.Count, "C").End(xlUp).Row
On Error Resume Next '//←念のため//
Range(wS3.Cells(2, "E"), wS3.Cells(lastRow, "G")).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
For j = 5 To 7
myMax = WorksheetFunction.Max(myMax, wS3.Cells(Rows.Count, j).End(xlUp).Row)
Next j
lastRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range(wS3.Cells(2, "C"), wS3.Cells(myMax, "C")).Copy
wS2.Cells(lastRow, "A").PasteSpecial Paste:=xlPasteValues
Range(wS3.Cells(2, "E"), wS3.Cells(myMax, "G")).Copy
wS2.Cells(lastRow, "B").PasteSpecial Paste:=xlPasteValues
End If
Next i
.AutoFilterMode = False
.Range("G:G").Delete
wS3.Cells.Clear
End With
Application.ScreenUpdating = True
wS2.Activate
wS2.Range("A1").Select
MsgBox "完了"
End Sub

※ もっと簡単な方法があるかもしれませんが、
まずはこの程度で・・・m(_ _)m
    • good
    • 0
この回答へのお礼

tom04さん、回答ありがとう御座います。

うわあぁぁ。す、すごいですね…めまいがしそうなほど難しいです…
ちょっと私の技量では何が何だか分からないです(汗
もう少し簡単に出来る物と思っていたのですが私の考えが甘かったようです。
この短時間にこれだけの物を真剣に書いて頂いて本当に心苦しく、そしてありがたく思っています。
すぐには活かせそうにありませんが時間をかけて少しずつ理解していこうと思います。
ありがとう御座いました!

お礼日時:2017/07/13 16:07

Excelに抽出の「関数」はありません。



既にマクロを使っているなら 数式で処理するのは論外だと思いますけど。

=IFERROR(1/IFERROR(1/MOD(SMALL((Sheet1!D$2:D$12="")*10^10+Sheet1!$C$2:$C$12,ROW($B1)),10^10),0),"")
Ctrl + Shift + Enterで確定

> VBAは勉強し始めたばかりで
やるなら基礎から勉強なさるべきかと思います。
    • good
    • 0
この回答へのお礼

d-q-t-pさん、まずは早速の回答ありがとうございます。

>やるなら基礎から勉強なさるべきかと思います。

おっしゃる通りだと思います。
ExcelでVBAを触りだしたのが数週間前、きっかけは20人ほどの職場(現場作業)で報告書を用紙に手書きで提出していたのをExcelのフォームにてやろうとしたのが始まりです。

現場作業員がほとんどなのでPCに詳しい者は皆無な中、挑戦してみました。Excelでユーザーフォームというものがある事さえその時知ったほどです。
PCに疎い者が多いのでなるべくユーザーフォームで入力したあと集計、印刷までをフォームのボタンを押すだけでOKな物を目指しました。

何も分からない状態でネットで調べつつ最終的にはそこそこ便利な物を作る事が出来たので面白さにはまってしまいました。
本屋で初心者向けのマクロ&VBAの書籍を買ってきて勉強しつつさらに別の物を作ろうと思ったのですがどうしても行き詰まってしまい質問させて頂きました。

上記の理由で入力から集計、印刷までをユーザーフォームで完結出来る(入力者はシートも基本的には開かない)物を望んでいます。
教えて頂いた物はシートが表示された状態でCtrl+Shift+Enterという作業をしないといけない物ですよね?違っていたらすみません。
だとすると希望する物には合致しません。申し訳ないです。
自分が勘違いしているかもしれないのでもう少し教えて頂いた物で試行錯誤してみます。

自分の力量以上の事をしようとしているのは重々承知しておりますが、それでも思った事が出来たときの面白さをどんどん味わいつつ勉強していこうと思います。
もうそこそこいい歳でなかなか覚えられませんが…

長文になり申し訳ありません。
ありがとう御座いました。

お礼日時:2017/07/13 15:58

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

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報