|
今晩は。
やって見ました。一応テストはしていますが、バグがあるかもしれないので、
色々動かしてみて下さい。
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
|
|