Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
データを別のシートに転記する
投稿日時: 20/06/10 13:47:23
投稿者: やっほー

こんにちは。
下記のような表が有ります。
sheet1(データ)
A列 |B列 |C列 
日付  |名前|合計
2020/6/1|鈴木|300
2020/6/2|鈴木|250
2020/6/3|鈴木|100
2020/6/4|鈴木|50
2020/6/1|田中|400
2020/6/2|山下|100
2020/6/2|田中|300
2020/4/1|町田|600
2020/6/3|田中|350
2020/4/9|町田|40
2020/6/3|山下|150
 :   : :
>Sheet2(別シート)
>  A列  | B列 | C列 | D列  | E列 … 
>名前/日付 | 6月1日| 6月2日| 6月3日|6月4日…
>      |  | | |
>     | | | |
>     | | | |
>    | | | |
>     | : | : | : | :
 ↓   ↓ ↓ 実行後 ↓
 
sheet2(別シート)
  A列  | B列 | C列 | D列  | E列 … 
名前/日付 | 6月1日| 6月2日| 6月3日|6月4日…
 鈴木   | 300 | 250 | 100 | 50
 田中 | 400 | 300 | 350 |
 佐々木 | 50 | | | 300
 山下 | | 100 | 150 |
  :   | : | : | : | :
データを別のシートに転記することは下記のコードで出来ましたが、
sheet2に表示されている合計の値の開始位置を自由に変更したいのですが、
どこをどの様に変えて良いかわかりません。
変更を試みても毎回、開始位置がB列の2行目からになってしまいます。
お手数ですが、よろしくお願いします。
Sub Macro4()
    Application.ScreenUpdating = False '画面ちらつき防止
 
    With Worksheets("Sheet2")
        .UsedRange.Offset(1).ClearContents '事前に更地化
 
        'コピペ
        Sheets("Sheet1").Columns("B").Copy
        .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
        '重複排除
        .Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes
 
        '日付がある最右列の番号を求める
        Dim rightest
        rightest = .Cells(1, 999).End(xlToLeft).Column
 
        '数式で集計し、その後に値化
        With .Range("B2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Resize(, rightest - 1)
            .FormulaR1C1 = "=SUMIFS(Sheet1!C3,Sheet1!C1,R1C,Sheet1!C2,Sheet2!RC1)"
            .Value = .Value
        End With
         
        .Select
        .Range("A1").Select
    End With
 
    Application.ScreenUpdating = True
End Sub

回答
投稿日時: 20/06/10 16:36:53
投稿者: QooApp

こんにちは、ちょっと自分の環境だと動かないようなので直接的な回答ではないのですが。
 
参考にされたサイトがありましたら教えてください。
それとも社内の古プログラムという感じでしょうか。
 
自分も投稿に失敗した直後だったのでここら辺のコメントがあるとプロな方が速攻で書いてくれると思います。
他力本願で申し訳ありません。

回答
投稿日時: 20/06/10 17:06:18
投稿者: sk

引用:
データを別のシートに転記することは下記のコードで出来ましたが、
sheet2に表示されている合計の値の開始位置を自由に変更したいのですが、
どこをどの様に変えて良いかわかりません。
変更を試みても毎回、開始位置がB列の2行目からになってしまいます。

引用:
With .Range("B2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Resize(, rightest - 1)

そもそも「自由に変更」というのは、具体的にどのような状況や操作を
想定された上での話なのでしょうか。

投稿日時: 20/06/11 00:06:02
投稿者: やっほー

sk さん
ご連絡ありがとうございます。
 
このプログラムを実行すると必ずB2から合計の値が貼り付けられます。
これをsheet2のC2から貼り付けを始めたり、D3から貼り付けを始めたりするには、
どこをどのように修正したら良いかわかりません。
全く違うプログラム(VBA)でも良いです。
初心者のためご指導頂きたいです。
 
sheet1(データ)
A列 |B列 |C列 
日付  |名前|合計
2020/6/1|鈴木|300
2020/6/2|鈴木|250
2020/6/3|鈴木|100
2020/6/4|鈴木|50
2020/6/1|田中|400
2020/6/2|山下|100
2020/6/2|田中|300
2020/4/1|町田|600
2020/6/3|田中|350
2020/4/9|町田|40
2020/6/3|山下|150
 :   : :
>Sheet2(別シート)
>  A列  | B列 | C列 | D列  | E列 … 
>名前/日付 | 6月1日| 6月2日| 6月3日|6月4日…
 
 
システムエンジニア1年目さん
メッセージありがとうございます。
サイトなどはありません。
自作のため、修正して頂くと幸いです。

回答
投稿日時: 20/06/11 08:07:19
投稿者: 虎

https://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=192148&rev=0
 
ここで作ってもらったコードですよね?

回答
投稿日時: 20/06/11 08:38:48
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

        '数式で集計し、その後に値化
        With .Range("B2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Resize(, rightest - 1)
             .FormulaR1C1 = "=SUMIFS(Sheet1!C3,Sheet1!C1,R1C,Sheet1!C2,Sheet2!RC1)"
             .Value = .Value
         End With
 

この数式の意味が理解できないところがあります。
 
まず、数式を代入するセルの開始は、B列セルなので
>.Range("B2:B"
は、B2からB列の最終行までではなく
A列の最終行の次の行ということになりませんか?
.Range("B" & .Cells(.Rows.Count, "A").End(xlUp).Row +1
に変更してみてください。
 
それから、代入する数式なんですが、
なぜ、SUMIFSを使用するのでしょうか?
単純に「SUM」関数ではダメなんでしょうか?

回答
投稿日時: 20/06/11 10:18:39
投稿者: takesi

A列の最終行=名前のある最終行=処理の完了行
 

引用:
"B2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row)

これでB2からB列の最終行(A列の最終行)

回答
投稿日時: 20/06/11 13:10:06
投稿者: sk

引用:
このプログラムを実行すると必ずB2から合計の値が貼り付けられます。
これをsheet2のC2から貼り付けを始めたり、D3から貼り付けを始めたりするには、
どこをどのように修正したら良いかわかりません。

(標準モジュール)
---------------------------------------------------------------
Sub Macro5()
    
    '集計元ワークシートに関する設定項目を定数で定義
    Const SourceSheetName As String = "Sheet1"  'ワークシート名
    Const DateColumn = "A"                      '[日付]列
    Const MemberColumn = "B"                    '[名前]列
    Const ValueColumn = "C"                     '[合計列](集計する値が格納された列)
    
    '出力先ワークシートに関する設定項目を定数で定義
    Const TableTopCell As String = "A1"         '表の基点セル
    
    '変数の宣言
    Dim wbkSource As Workbook
    Dim wsSource As Worksheet
    Dim rngDateColumn As Range
    Dim rngMemberColumn As Range
    Dim rngValueColumn As Range
    
    Dim wbkDestination As Workbook
    Dim wsDestination As Worksheet
    Dim rngTableTopCell As Range
    
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim lngDay As Long
    Dim lngDaysInPeriod As Long
    
    Dim lngFirstRow As Long
    Dim lngFirstColumn As Long
    
    Dim lngLastRow As Long
    Dim lngLastColumn As Long
    
    Dim strFormula As String
    Dim varArg() As Variant
    
    
'**** ここから処理開始 ****

    'システム日付を基準に[日付]の範囲を算出
    dtStart = DateSerial(Year(Date), Month(Date), 1)    '月初日
    dtEnd = DateAdd("m", 1, dtStart) - 1                '月末日
    lngDaysInPeriod = DateDiff("d", dtStart, dtEnd) + 1 '日数
    
    '集計元ワークシートのあるブックの参照
    '(とりあえずこのモジュールのあるブック自身とする)
    Set wbkSource = ThisWorkbook
    '集計元ワークシートの参照
    Set wsSource = wbkSource.Worksheets(SourceSheetName)
    '[日付]列の参照
    Set rngDateColumn = wsSource.Columns(DateColumn)
    '[名前]列の参照
    Set rngMemberColumn = wsSource.Columns(MemberColumn)
    '[合計]列の参照
    Set rngValueColumn = wsSource.Columns(ValueColumn)
    
    '出力先となるブックの新規作成と参照
    Set wbkDestination = Application.Workbooks.Add
    '出力先ワークシートの参照
    Set wsDestination = wbkDestination.Worksheets(1)
    '既存のブック/ワークシートを参照する場合は適宜書き換えること
    
    
    'マクロ実行中の画面表示の更新を無効にする
    Application.ScreenUpdating = False
     
    '出力先ワークシートの操作
    With wsDestination
        '名前の設定
        .Name = Format(dtStart, "yyyy年mm月度集計表")
        '出力先の基点(表の左上)となるセルを参照
        Set rngTableTopCell = .Range(TableTopCell)
    End With
    
    '基点セルを軸に周辺のセル範囲を操作
    With rngTableTopCell
        
        '先頭行の番号を取得
        lngFirstRow = .Row
        '先頭列の番号を取得
        lngFirstColumn = .Column
        
        '**** [名前]列の設定 ****
        
        '集計元ワークシートから[名前]列をコピー
        wsSource.Range(rngMemberColumn.Cells(1, 1), _
                       rngMemberColumn.Cells(rngMemberColumn.Rows.Count, 1).End(xlUp)).Copy
    
        '基点セルに貼り付け
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        '重複の削除
        .EntireColumn.RemoveDuplicates Columns:=1, Header:=xlYes
    
        '**** 列見出しの設定 ****
        
        '基点セルの1つ右のセルに月初日を代入
        .Offset(0, 1).Value = dtStart
        '更にセル書式を設定
        .Offset(0, 1).NumberFormatLocal = "m月d日"
        '最終列までオートフィル
        .Offset(0, 1).AutoFill Destination:=wsDestination.Range(.Offset(0, 1), .Offset(0, lngDaysInPeriod)), _
                               Type:=xlFillDays
    End With
        
    '**** 数式の生成 ****
    
    '引数リスト用の配列を再定義
    ReDim varArg(0 To 4)
    '集計元ワークシートの[合計]列全体を集計範囲に
    varArg(0) = rngValueColumn.Address(True, True, , True)
    '集計元ワークシートの[日付]列全体を条件範囲1に
    varArg(1) = rngDateColumn.Address(True, True, , True)
    '出力元シートの見出し行(日付)のうち、数式セルと同じ列のセルを条件1に
    varArg(2) = rngTableTopCell.Offset(0, 1).Address(True, False)
    '集計元ワークシートの[名前]列全体を条件範囲2に
    varArg(3) = rngMemberColumn.Address(True, True, , True)
    '出力元シートの[名前]列のうち、数式セルと同じ行のセルを条件範囲2に
    varArg(4) = rngTableTopCell.Offset(1, 0).Address(False, True)
    
    '上記の引数が設定された SUMIF 関数を用いた数式を構成
    strFormula = "=SUMIFS(" & Join(varArg, ",") & ")"
    'デバッグ用
    Debug.Print strFormula
        
    '出力先ワークシートの操作
    With wsDestination
        
        '最終行の番号の取得
        lngLastRow = .Cells(.Rows.Count, lngFirstColumn).End(xlUp).Row
        '最終列の番号を取得
        lngLastColumn = lngFirstColumn + lngDaysInPeriod
        
        '集計結果の出力先となるセル範囲の操作
        With .Range(.Cells(lngFirstRow + 1, lngFirstColumn + 1), _
                    .Cells(lngLastRow, lngLastColumn))
            '数式の設定
            .Formula = strFormula
            '値に変換
            .Value = .Value
        End With
                 
        'シートを選択
        .Select
        'A1セルの選択
        .Cells(1, 1).Select
    End With
    
    '出力先ブックをアクティブに
    wbkDestination.Activate
    
    'マクロ実行中の画面表示の更新を有効にする
    Application.ScreenUpdating = True
    
    
'**** 参照解放 ****
    
    Set rngTableTopCell = Nothing
    Set wsDestination = Nothing
    Set wbkDestination = Nothing
    
    Set rngValueColumn = Nothing
    Set rngMemberColumn = Nothing
    Set rngDateColumn = Nothing
    Set wsSource = Nothing
    Set wbkSource = Nothing

End Sub
---------------------------------------------------------------
要するに、以上のようなコードを記述したい、ということでしょうか。
 
(ピボットテーブルを使えば解決する問題なのでは、と思いますが)

回答
投稿日時: 20/06/11 13:17:57
投稿者: sk

WinArrow さんの引用:
まず、数式を代入するセルの開始は、B列セルなので
>.Range("B2:B"
は、B2からB列の最終行までではなく
A列の最終行の次の行ということになりませんか?

WinArrow さんの引用:
単純に「SUM」関数ではダメなんでしょうか?

「 Macro4 プロシージャによって Sheet2 に出力された表に、
更に合計行を追加したい」という主旨の質問ではないですよ、これ。

回答
投稿日時: 20/06/11 13:25:58
投稿者: WinArrow
投稿者のウェブサイトに移動

すみません、勘違いしていました
投稿日時: 20/06/11 08:38:48
のレスは無視してください。

回答
投稿日時: 20/06/11 13:40:08
投稿者: sk

訂正:

sk さんの引用:
'重複の削除
.EntireColumn.RemoveDuplicates Columns:=1, Header:=xlYes

列全体ではマズいことになるので、以下のように書き換えて下さい。
 
--------------------------------------------------------------------
        With wsDestination
            '最終行の番号の取得
            lngLastRow = .Cells(.Rows.Count, lngFirstColumn).End(xlUp).Row
    
            '重複の削除
            .Range(.Cells(lngFirstRow + 1, lngFirstColumn), _
                   .Cells(lngLastRow, lngFirstColumn)).RemoveDuplicates Columns:=1, Header:=xlNo
        End With

投稿日時: 20/06/11 14:02:25
投稿者: やっほー

sk さん
虎 さん
WinArrow さん
takesi さん
 
ご回答ありがとうございます。
皆様に感謝申し上げます。
こちら一旦、試してみます。
 
skさん
プログラムの記述をありがとうございます。
一度、試して改めて回答します。
本当にありがとうございました。

投稿日時: 20/06/11 17:16:39
投稿者: やっほー

皆様、色々なご意見をありがとうございました。