Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9122 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【29227】別シートからのデータ抽出、挿入について 肇 05/9/28(水) 1:30

【29233】Re:別シートからのデータ抽出、挿入について Jaka 05/9/28(水) 16:11

【29241】Re:別シートからのデータ抽出、挿入につ... 肇 05/9/28(水) 18:05

【29250】Re:別シートからのデータ抽出、挿入につ... Jaka 05/9/29(木) 10:01


	【29227】別シートからのデータ抽出、挿入について

肇 - 05/9/28(水) 1:30 -


	引用なし

	パスワード

Worksheets("データ")　に日々のデータを記録（1年分）しています。このデータをシートチェンジを使いWorksheets("月報")　にNoを記載するだけでデータの転記を試みています。今の問題点としてWorksheets("データ")は日付がとびとびで Worksheets("月報")　は日付が1ヶ月連続していますので単純にコピーペーストが出来ません。（日付はシリアル値です。） Noと日付が交差するところにデータを挿入したいのですが分かりません。どうかご指導をお願いいたします。 Worksheets("データ") 　Ａ　Ｂ　　Ｃ　　Ｄ　　Ｅ　　Ｆ　　Ｇ　　Ｈ　Ｉ　Ｊ　Ｋ・・・FV　　FW １２３No　名称　区分　提供　価格　単位　1/3　1/5　1/6　1/8　1/11・・9/24　9/27 ４010 a-1　　　　　　　　　　　個　　10　　　　45　19　　52　　　63　　23 ５020 a-2　　　　　　　　　　　個　　80　60　　70　63　　72　　　30　　　６030 b-1　　　　　　　　　　　個　　15　56　　79　35　　34　　　78　　44 ７040 b-3　　　　　　　　　　　個　　36　　　　　　62　　92　　　10　　36 ８050 d-2　　　　　　　　　　　枚　　43　　　　86　　　　88　　　50　　21 ９060 d-4　　　　　　　　　　　枚　　28　78　　25　42　　70　　　31　　66 ・・ Worksheets("月報") 　　Ａ　　　Ｂ　　Ｃ　　Ｄ　　Ｅ　　Ｆ　　Ｇ　　Ｈ　Ｉ　Ｊ　Ｋ１　No　　　010　030 ２　名称　　a-1　b-1 ３　単位　　個　　個４５ 8月1日　 15　　20 ６ 8月2日　 23　　15 ７ 8月3日　　　　 11 ８ 8月4日９ 8月5日　 17　　25 10 8月6日　 23　　36 ・　・・　・・　・ 35 8月31日　25 36 37　合計　　421　525 38　最大値　25　　45 39　最小値　12　　11


	【29233】Re:別シートからのデータ抽出、挿入につ...

Jaka - 05/9/28(水) 16:11 -


	引用なし

	パスワード

>（日付はシリアル値です。）
CDblで、シリアル値に変換するか、Value2でセルのシリアル値を使えば、
エクセル関数のMatchが使えます。
MsgBox CDbl(CDate("2005/8/8"))

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim CLCOL As Long, NoHt As Variant, DtHt As Variant, i As Long
If Target.Row <> 1 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
CLCOL = Target.Column
Application.EnableEvents = False
NoHt = Application.Match(Target.Value, Sheets("データ").Columns(1), 0)
If Not IsError(NoHt) Then
　 Sheets("月報").Cells(2, CLCOL).Value = Sheets("データ").Cells(NoHt, 2).Value
　 Sheets("月報").Cells(3, CLCOL).Value = Sheets("データ").Cells(NoHt, 6).Value
　　　　　　　　　　'↓ここの最終行は、適当に変えてください。
　 For i = 5 To Sheets("月報").Range("A65536").End(xlUp).Row
　　　 DtHt = Application.Match(Sheets("月報").Cells(i, 1).Value2, Sheets("データ").Rows(3), 0)
　　　 If Not IsError(DtHt) Then
　　　　　Sheets("月報").Cells(i, CLCOL).Value = Sheets("データ").Cells(NoHt, DtHt).Value
　　　 Else
　　　　　'Sheets("月報").Cells(i, CLCOL).Value = "無し"
　　　 End If
　 Next
Else
　 MsgBox "Noなし"
End If
Application.EnableEvents = True
End Sub


	【29241】Re:別シートからのデータ抽出、挿入につ...

肇 - 05/9/28(水) 18:05 -


	引用なし

	パスワード

Jaka さん　ありがとうございました。
動作に感動しました。

少し改良しTargetの行を下へ移動し、
A2に年、B2に月を入れることにしました。
それで自動でRange("A9:A39")に日付を入れようと考えましたが
マクロが動作しません。

アドバイスをお願いいたします。

Private Sub Worksheets_Change(ByVal Target As Range)
　Dim themonth As Integer
　Dim theyear As Integer
　Dim days As Integer

　With Target
　　If IsEmpty(.Value) Then Exit Sub
　　If Not IsNumeric(.Value) Then Exit Sub
　　If .Count > 1 Then Exit Sub
　End With

　'入力セルがA2とB2の場合のみ処理する
　If Target.Address = Range("A2").Address Or _
　　Target.Address = Range("B2").Address Then
　
　　'A2とB2に数値が入力してあれば、処理する。
　　If Range("A2").Value <> "" And Range("B2").Value <> "" And _
　　　IsNumeric(Range("A2").Value) And IsNumeric(Range("B2").Value) Then
　　　　'前回の値をクリアする。
　　　　Range("A9:A39").ClearContents
　　　　'年のセル
　　　　theyear = Range("A2").Value
　　　　'月のセル
　　　　themonth = Range("B2").Value
　　　　'月の値が1～12かをチェック
　　　　If themonth >= 1 And themonth <= 12 Then
　　　　　With Range("A9")
　　　　　　'１ヶ月分の日付を生成する。
　　　　　　For days = 1 To Day(DateSerial(theyear, themonth + 1, 1) - 1)
　　　　　　　.Offset(days - 1).Value = DateSerial(theyear, themonth, days)
　　　　　　Next
　　　　　End With
　　　　Else
　　　　　MsgBox "月の値は、1～12を入力してください。"
　　　　　Range("B2").Select
　　　　End If
　　End If
　　'以下、別にいらない機能？
　　If Target.Address = Range("A2").Address Then
　　　Range("B2").Select
　　End If
　　If Target.Address = Range("B2").Address Then
　　　Range("A2").Select
　　End If
　　'ここまで
　End If
End Sub


	【29250】Re:別シートからのデータ抽出、挿入につ...

Jaka - 05/9/29(木) 10:01 -


	引用なし

	パスワード

日付ならこんな感じにフィルした方が、簡単だと思います。
フィルできる状況なのかわかりませんが....。

nen = 2005
tuki = 10
EDD = Format(DateSerial(nen, tuki + 1, 1) - 1, "d")
Range("A2").Value = DateSerial(nen, tuki, 1)
Range("B2").Value = Format(DateSerial(nen, tuki, 1), "aaa")
Range("A2:B2").AutoFill Destination:=Range("A2:B2").Resize(EDD), Type:=xlFillDefault


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9122 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free