Excel VBA質問箱 IV

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

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


40004 / 76738 ←次へ | 前へ→

【41838】Re:3つの表を1つに集計
回答  ナイスプログラム WEB  - 06/8/23(水) 22:48 -

引用なし
パスワード
    今晩は。

 やって見ました。一応テストはしていますが、バグがあるかもしれないので、
色々動かしてみて下さい。


Option Explicit
Option Base 1

Dim sinki As Object
Dim vv1 As Variant, vv2 As Variant, vv3 As Variant, vv4 As Variant
Dim ir1 As Integer, ic1 As Integer, ir2 As Integer, ic2 As Integer
Dim code As Integer
Dim name As String, customer As String
Dim price As Long
Dim start As Boolean


Sub 担当者()

vv1 = ThisWorkbook.Worksheets("sheet1").Range("a1").CurrentRegion.Value
vv2 = ThisWorkbook.Worksheets("sheet2").Range("a1").CurrentRegion.Value
vv3 = ThisWorkbook.Worksheets("sheet3").Range("a1").CurrentRegion.Value

ir1 = 1
ic1 = 3

Workbooks.Add
Set sinki = ActiveWorkbook

Call 新規記入(vv1)
Call 新規記入(vv2)
Call 新規記入(vv3)

Range("A1").Sort Key1:=Range("A2"), Header:=xlGuess
Range("C2").Sort Key1:=Range("C2"), Header:=xlGuess

vv1 = sinki.ActiveSheet.Range("a1").CurrentRegion.Value

表編集


End Sub

Private Sub 新規記入(vv)

Dim i As Integer

ir2 = ir1 + UBound(vv, 1) - 1
ic2 = UBound(vv, 2)

Range(Cells(ir1, 1), Cells(ir2, ic2)).Value = vv

For i = ir1 To ir2
  Cells(i, ic2 + 1).Value = ic1
Next

If ir1 > 1 Then Rows(ir1).EntireRow.Delete
ir1 = Range("a65535").End(xlUp).Row + 1
ic1 = ic1 + 1

End Sub

Private Sub 表編集()

Dim ssv As Variant
Dim i As Integer

sinki.ActiveSheet.Cells.ClearContents

ssv = Array("担当者", "得意先名", "売上金額1", "売上金額2", "売上金額3")
For i = 1 To 5
  Cells(1, i).Value = ssv(i)
Next

ir1 = 2
ir2 = 1
For i = 2 To UBound(vv1, 1)
  If vv1(i, 3) <> code Then
    If ir2 > 1 Then
      ir2 = ir2 + 1
      合計
    End If
    start = True
    code = vv1(i, 3)
    name = vv1(i, 4)
  End If
  
  If customer <> vv1(i, 1) Then
    customer = vv1(i, 1)
    If start = False Then ir2 = ir2 + 1
  End If
    
  price = vv1(i, 2)
  ic1 = vv1(i, 5)
  記入
    
Next
ir2 = ir2 + 1
合計

End Sub

Private Sub 記入()

If start = True Then
  ir2 = ir2 + 1
  Cells(ir2, 1).Value = name
  start = False
End If

Cells(ir2, 2).Value = customer
Cells(ir2, ic1).Value = price

End Sub

Private Sub 合計()

Dim i As Integer, j As Integer, total As Integer

For j = 3 To 5
  For i = ir1 To ir2 - 1
    
     total = total + Cells(i, j).Value
    
  Next
  Cells(ir2, j).Value = total
  total = 0
Next

Cells(ir2, 2).Value = name & "合計"
ir1 = ir2 + 1


End Sub
0 hits

【41447】3つの表を1つに集計 Help me!! 06/8/10(木) 14:59 質問
【41484】Re:3つの表を1つに集計 ナイスプログラム 06/8/12(土) 0:38 質問
【41645】Re:3つの表を1つに集計 ℃素人 06/8/18(金) 8:52 発言
【41838】Re:3つの表を1つに集計 ナイスプログラム 06/8/23(水) 22:48 回答
【41663】Re:3つの表を1つに集計 Kein 06/8/18(金) 16:48 回答

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