台灣最大程式設計社群網站
線上人數
1492
 
會員總數:242954
討論主題:187844
歡迎您免費加入會員
討論區列表 >> VB6 >> 求確認 程式有沒有錯
[]  
[我要回覆]
1
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
求確認 程式有沒有錯
價值 : 50 QP  點閱數:321 回應數:1

樓主

Ginny Chang
門外漢
0 1
16 0
發送站內信

Sub 月銷售()

Dim Month As Variant
Dim boxprompt$
Dim boxtitle$
Dim boxdefault%
Dim TableTitle$

Worksheets("月銷售").Activate
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select

'製作標題
boxprompt = "請輸入所須月份"
boxtitle = "月銷售管理表"
boxdefault = 4
Month = inputbox(boxprompt, boxtitle, boxdefault)



'讀取客戶數目 NumClient
'A1:B1 "原始"起始位置 ; A2:B2 "月銷售"起始位置 ; Counter 列數目
Worksheets("原始").Activate
'A1Orgin = 1: B1Orgin = 1: A1 = A1Orgin: B1 = B1Orgin
'A2Orgin = 3: B2Orgin = 1: A2 = A2Orgin: B2 = B2Orgin
A1 = 1: B1 = 1: A2 = 3: B2 = 1
Counter = 2
NumClient = Cells(A1 + 1, B1) ' NumClient 表示客戶數


'依客戶順序讀取"原始"所需資料,I
'依客戶使用藥品品項NumChem讀取"原始"所需資料,J
A1 = A1 + 2
A2 = A2 + 1
Target1 = B1 + 9 + Month * 1
Target2 = B1 + 10 + Month * 1
For I = 1 To NumClient + 1 '客戶數
Worksheets("原始").Activate
NumChem = Cells(A1, B1 + 1) '該客戶採用藥品種類
For J = 1 To NumChem
Worksheets("原始").Activate
TValue1 = Cells(A1, Target1).Value
TValue2 = Cells(A1, Target2).Value
If TValue1 = 0 And TValue2 = 0 Then
ElseIf TValue1 <> "" Or TValue2 <> "" Then
Set R1 = Range(Cells(A1, B1 + 5), Cells(A1, B1 + 6))
Set R2 = Cells(A1, B1 + 11)
Set R3 = Range(Cells(A1, Target1), Cells(A1, Target2))
'選取該項藥品各月份銷售額
Union(R1, R2, R3).Select
Selection.Copy
Worksheets("月銷售").Activate
Cells(A2, B2).Select
ActiveSheet.Paste
A2 = A2 + 1
Counter = Counter + 1
Else
End If
Worksheets("月銷售").Activate
A1 = A1 + 1
Next J
Next I

Worksheets("月銷售").Activate
Columns("E:E").Select
Selection.Copy
Columns("F:F").Select
ActiveSheet.Paste
Columns("E:E").Select
Application.CutCopyMode = False
Selection.ClearContents


Cells(4, 5).Select
ActiveCell.FormulaR1C1 = "=+RC3*RC4"
Cells(4, 5).Select
Selection.Copy
Range(Cells(4, 5), Cells(A2 - 1, 5)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Cells(4, 7).Select
ActiveCell.FormulaR1C1 = "=+RC3*RC6"
Cells(4, 7).Select
Selection.Copy
Range(Cells(4, 7), Cells(A2 - 1, 7)).Select
ActiveSheet.Paste
Application.CutCopyMode = False


'"表格甲"資料繪製框格線
Worksheets("月銷售").Activate

Range(Cells(3, 1), Cells(A2 - 1, 8)).Select
With Selection.Font
.Name = "標楷體"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = xlHorizontal
.AddIndent = False
End With
With Selection.Borders(xlLeft)
.Weight = xlThin
.ColorIndex = 30
End With
With Selection.Borders(xlRight)
.Weight = xlThin
.ColorIndex = 30
End With
With Selection.Borders(xlTop)
.Weight = xlThin
.ColorIndex = 31
End With
With Selection.Borders(xlBottom)
.Weight = xlThin
.ColorIndex = 31
End With
Selection.BorderAround Weight:=xlMedium, ColorIndex:=32
Range("G6").Select

With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With

'標題
Worksheets("月銷售").Activate
TableTitle = "北區營業課" & Month & "月銷售管理表"
Cells(1, 1).Value = TableTitle
Range(Cells(1, 1), Cells(1, 8)).Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = xlHorizontal
.AddIndent = False
End With
With Selection.Font
.Name = "標楷體"
.FontStyle = "標準"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = xlAutomatic
End With

Cells(2, 1).Value = "製表人:"
Cells(2, 6).Value = "製表日期:"

Range(Cells(2, 1), Cells(2, 8)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = xlHorizontal
.AddIndent = False
End With
With Selection.Font
.Name = "標楷體"
.FontStyle = "標準"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = xlAutomatic
End With
Cells(2, 1).Value = "製表人:張櫻君"
Cells(2, 6).Value = "製表日期:"
Cells(3, 1).Value = "客 戶 名 稱"
Cells(3, 2).Value = "產 品 名 稱"
Cells(3, 3).Value = "單 價"
Cells(3, 4).Value = "預 估 數 量"
Cells(3, 5).Value = "預 估 總 額"
Cells(3, 6).Value = "實 際 數 量"
Cells(3, 7).Value = "實 際 總 額"
Cells(3, 8).Value = "備 註 (新 單)"
Cells(2, 7).Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("G2:H2").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = xlHorizontal
.AddIndent = False
End With
Selection.NumberFormat = "e""年""m""月""d""日"""

Range(Cells(3, 1), Cells(3, 8)).Select
With Selection.Font
.Name = "標楷體"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = xlHorizontal
.AddIndent = False
End With

'標題底
Cells(A2 + 1, 1).Value = "保持:"
Cells(A2 + 1, 3).Value = "開拓:"
Cells(A2 + 1, 5).Value = "(含回轉)"
Cells(A2 + 1, 6).Value = "TOTAL:"
Cells(A2 + 1, 8).Value = "(估)"
Cells(A2 + 2, 6).Value = "TOTAL:"
Cells(A2 + 2, 8).Value = "(實)"
Cells(A2 + 5, 2).Value = "部門主管:"
Cells(A2 + 5, 5).Value = "單位主管:"

Range(Cells(A2 + 1, 1), Cells(A2 + 5, 8)).Select
With Selection.Font
.Name = "標楷體"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = xlAutomatic
End With

Union(Cells(A2 + 1, 1), Cells(A2 + 1, 3), Cells(A2 + 1, 6), Cells(A2 + 2, 6)).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
.AddIndent = False
End With

Set R1 = Cells(A2 + 1, 2)
Set R2 = Cells(A2 + 1, 4)
Set R3 = Range(Cells(A2 + 1, 7), Cells(A2 + 2, 8))
Set R4 = Range(Cells(A2 + 5, 3), Cells(A2 + 5, 4))
Set R5 = Range(Cells(A2 + 5, 6), Cells(A2 + 5, 7))
Union(R1, R2, R3, R4, R5).Select
Selection.Borders(xlLeft).LineStyle = xlNone
Selection.Borders(xlRight).LineStyle = xlNone
Selection.Borders(xlTop).LineStyle = xlNone
With Selection.Borders(xlBottom)
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.BorderAround LineStyle:=xlNone

Cells(A2 + 1, 7).FormulaR1C1 = "=SUM(R[-43]C[-2]:R[-2]C[-2])"
Cells(A2 + 2, 7).FormulaR1C1 = "=SUM(R[-43]C:R[-2]C)"

'表格格式
Columns("A:A").Select
Selection.ColumnWidth = 18
Columns("B:B").Select
Selection.ColumnWidth = 25.5
Columns("C:F").Select
Selection.ColumnWidth = 8
Columns("G:G").Select
Selection.ColumnWidth = 9.22
Columns("H:H").Select
Selection.ColumnWidth = 12

Rows("1:1").Select
Selection.RowHeight = 29
Rows("2:2").Select
Selection.RowHeight = 25
Rows("3:3").Select
Selection.RowHeight = 40
Range(Cells(4, 1), Cells(A2 + 1, 1)).Select
Selection.RowHeight = 18
Range(Cells(A2, 1), Cells(A2 + 5, 1)).Select
Selection.RowHeight = 20

End Sub


求達人幫忙看一下這個程式有沒有哪邊有錯的@@

下了月份指令,卻只會跑出4月份的資料...

搜尋相關Tags的文章: [ VB ] ,
本篇文章發表於2018-02-08 16:19
別忘捐VP感謝幫助你的人 新手會員瞧一瞧
1樓
回應

香帥
檢舉此回應
建議上傳檔案,比較容測試得到幫助。
不然很難看出變數意義,
我只能看出以下是否有誤或多餘的

任何數*1 都是等於 任何數
Month * 1 = MOHTH
那個 * 1 是否要改為 * A1 或 * B1.... 才會變化
本篇文章回覆於2018-02-10 22:44
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
   
1

回覆
如要回應,請先登入.