Excel VBA質問箱 IV

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

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


52506 / 76732 ←次へ | 前へ→

【29064】Re:データの埋め込み
発言  ichinose  - 05/9/22(木) 22:39 -

引用なし
パスワード
   ▼M さん:
こんばんは。

>
>当方からの説明が不十分で、失礼致しました。
>意図が伝わらずに苦慮しています。表現が十分に出来ず申し訳けございません。
苦慮してください・・・。後々には必ず、役に立ちます。
私は、そう思っています。


さて、再度、
新規ブックにSheet1とSheet2というシート名持つシートを作成してください。

>
>
>番号   項目1   項目2  項目3  項目4   項目5
>101    AAA    500    300    200    500
>102    BBB    400    100     50    400
>104    DDD    600     0    250    600
>105    EEE    150     50     0    150
>107    FFF    600     0     0    600
>109    HHH    180     80     50    180
>

Sheet1のセルA1から、↑のデータが入力されているとします。

Sheet2のセルA1から、

    A    B
1  番号   項目1
2  101    AAA
3  102    BBB
4  103    PPP
5  104    DDD
6  105    EEE
7  107    FFF
8  108    GGG
9  109    HHH

というマスターデータ入力しておきます。


標準モジュールに

'============================================================
Sub test()
  Dim strow As Long
  Dim sh1rng As Range
  Dim sh2rng As Range
  With Worksheets("sheet1")
   Set sh1rng = .Range("a2", .Cells(.Rows.Count, 1).End(xlUp))
   End With
  If sh1rng.Row > 1 Then
    With Worksheets("sheet2")
     Set sh2rng = .Range("a2", .Cells(.Rows.Count, 1).End(xlUp))
     With sh2rng.Offset(0, 2)
       .Formula = "=if(countif(" & sh1rng.Offset(0, 1).Address(, , , True) & _
            ",b2)=0,0,"""")"
       On Error Resume Next
       Set addrng = .SpecialCells(xlCellTypeFormulas, xlNumbers)
       If Err.Number = 0 Then
        strow = sh1rng.Row + sh1rng.Rows.Count
        With Worksheets("sheet1")
          For Each crng In addrng.Offset(0, -2)
           .Range(.Cells(strow, 1), .Cells(strow, 2)).Value = crng.Resize(, 2).Value
           .Range(.Cells(strow, 3), .Cells(strow, 6)).Value = 0
           strow = strow + 1
           Next
          With .Range("a1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 6)
           .Sort key1:=.Range("a1"), header:=xlYes
           End With
          End With
        End If
       .Formula = ""
       On Error GoTo 0
       End With
     End With
    End If
End Sub


これで、確認してください


>上の表は、あるデータからエクセルに張り込んだデータです。
>しかし103のPPPのデータが欠落された状態です。(その日に数字の全く動きのない状態のため、そのデータが消えて存在しない状態なのです)108のGGGも今日何ら動きが無いため
>データの存在が無いのです。合計2行のデータが欠落しています。
>
>仕上がりは下の表のようにしたいのです。
>しかも、シート1だけでするようにしたいんですが。
>
>又、明日のデータは変化します。例えば103のPPPの1列だけが無い状態かも知れません。
>
>日計データの動きの無い場合は項目2〜5まで0という数字を埋めて、いつも仕上がりの表が同じ行数・列数になるように仕上げたいんです。項目1のAAA〜HHHは8行です。項目名と順番は変わりません。仕上がりも、いつも8行で仕上げたいんです。またできれば検索の列を項目1でしたいんですが。
>
>説明が不十分ですが、申し訳けございませんが、よろしくお願いします。
>
>
>仕上がり
>
>     項目1  項目2   項目3  項目4  項目5
>101    AAA    500    300    200    500
>102    BBB    400    100     50    400
>103    PPP     0     0     0     0
>104    DDD    600     0    250    600
>105    EEE    150     50     0    150
>107    FFF    600     0     0    600
>108    GGG     0     0     0    0
>109    HHH    180     80     50    180

0 hits

【29022】データの埋め込み M 05/9/21(水) 20:57 質問
【29036】Re:データの埋め込み M 05/9/22(木) 7:11 質問
【29038】Re:データの埋め込み ichinose 05/9/22(木) 8:29 発言
【29063】Re:データの埋め込み M 05/9/22(木) 21:25 質問
【29064】Re:データの埋め込み ichinose 05/9/22(木) 22:39 発言
【29083】Re:データの埋め込み M 05/9/23(金) 16:31 お礼
【29087】Re:データの埋め込み ichinose 05/9/23(金) 18:40 発言
【29095】Re:データの埋め込み M 05/9/23(金) 21:59 お礼

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