Excel VBA質問箱 IV

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

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


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

40073 / 76807

←次へ　｜　前へ→


	【41838】Re:３つの表を１つに集計

ナイスプログラム

- 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("担当者", "得意先名", "売上金額１", "売上金額２", "売上金額３")
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】３つの表を１つに集計 Help me!! 06/8/10(木) 14:59