Excel VBA質問箱 IV

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

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


15233 / 76738 ←次へ | 前へ→

【66986】Re:列と行が一致した所にデータを挿入したい
発言  kanabun  - 10/10/22(金) 23:21 -

引用なし
パスワード
   ▼ひぃちゃん さん:

こんにちは。
以下は Hirofumiさんのコードをトレースしながら、
我流で書いたものです。
参考まで

'------------------------------------------- 新しい標準モジュール
Option Explicit
Private Day1 As Long
Private Dayz As Long  'Sheet2の1行目 最初の日付と 最後の日付

Sub Try1()
 Dim WS1 As Worksheet: Set WS1 = Worksheets("Sheet1") 'ソース
 Dim WS2 As Worksheet: Set WS2 = Worksheets("Sheet2") '出力
 Dim Tbl1 As Range
 Dim Tbl2 As Range
 Dim arry
 Set Tbl1 = WS1.[A1].CurrentRegion
 Set Tbl2 = WS2.[A1].CurrentRegion
 Set Tbl2 = Intersect(Tbl2, Tbl2.Offset(1, 1))
 Tbl2.ClearContents
 arry = Tbl2.Value
 
 Dim dic As Object
 Dim v, i As Long
 Set dic = CreateObject("Scripting.Dictionary")

'> Sheet2にマスターとしてA列に品目番号、1行目に日付があります。
 '品目番号の行位置をDictionaryに記憶します
 v = Tbl2.Columns(0).Value
 For i = 1 To UBound(v)
   dic(v(i, 1)) = i
 Next
 Day1 = Tbl2.Item(0, 1).Value2
 Dayz = Tbl2.Item(0, Tbl2.Columns.Count).Value2
 '--- 以上で,出力先の<行,列座標>関係が明らかになりました
 
 '--- これより Sheet1のデータをtbl2用配列に送り込みます
 Dim n As Long, m As Long
 v = Tbl1.Value
 For i = 1 To UBound(v)
  If dic.Exists(v(i, 1)) Then
    n = dic(v(i, 1))
    m = ToDate(CStr(v(i, 3)))
    If m Then
      arry(n, m) = v(i, 4)
    End If
  End If
 Next
 Tbl2.Value = arry '配列を Sheet2.Tbl2 に貼りつけます
 Set dic = Nothing
 
End Sub

'文字列("12/1/10" など)を日付けに直し、
'Sheet2一行目の日付に対応した位置を返す関数
Private Function ToDate(ss As String) As Long
 Dim v, i As Long
 v = Split(ss, "/")
 If UBound(v) = 2 Then
   i = DateSerial(v(2) - (v(2) < 100) * 2000, v(0), v(1))
   Select Case i
    Case Day1 To Dayz
     ToDate = i - Day1 + 1
   End Select
 End If
End Function

0 hits

【66968】列と行が一致した所にデータを挿入したい ひぃちゃん 10/10/21(木) 21:58 質問
【66970】Re:列と行が一致した所にデータを挿入したい Hirofumi 10/10/21(木) 22:16 発言
【66971】Re:列と行が一致した所にデータを挿入したい ひぃちゃん 10/10/21(木) 22:32 質問
【66973】Re:列と行が一致した所にデータを挿入したい Hirofumi 10/10/22(金) 0:13 回答
【66985】Re:列と行が一致した所にデータを挿入したい ひぃちゃん 10/10/22(金) 22:32 お礼
【66986】Re:列と行が一致した所にデータを挿入したい kanabun 10/10/22(金) 23:21 発言
【66987】Re:列と行が一致した所にデータを挿入したい ひぃちゃん 10/10/23(土) 19:42 お礼
【66991】Re:列と行が一致した所にデータを挿入したい Hirofumi 10/10/24(日) 10:50 発言
【67008】Re:列と行が一致した所にデータを挿入したい ひぃちゃん 10/10/25(月) 20:16 お礼

15233 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free