|
|
楼主 |
发表于 2021-12-11 15:51
|
显示全部楼层
太完美了，都不知道怎么感谢你了
帮我看一下下面的代码，我不知道哪里错了，那个月日怎么都转换不来呢，到我表里就成如图片上的那种显示了 ：
- Private Sub cmd查询_Click()
- Application.ScreenUpdating = False
- Dim endrow As Long
- Dim i As Long, j As Long, k As Long
- Dim dt1 As Date, dt2 As Date
- Dim qc, balance
- Dim r As Long, rr As Long
- Dim ljj, ljd, ljc
- Dim jf, df, yf
- If TextBox1.Text = "" Then
- MsgBox "请选择项目"
- Else
- Range("A5:G" & Rows.Count).ClearContents
- Range("A5:G" & Rows.Count).Borders.LineStyle = xlNone
- Range("A5:G" & Rows.Count).Interior.ColorIndex = xlNone
- Sheet13.Range("A:E").ClearContents
- dt1 = CDate(Me.txt开始日)
- dt2 = CDate(Me.txt终了日)
- Range("C2") = Me.TextBox1.Text
- Range("D2") = Format(dt1, "yyyy/m/d") & "~" & Format(dt2, "yyyy/m/d")
- Sheet13.Range("A1:E1") = Array("日期", "往来单位", "摘要", "收入金额", "支出金额")
- '数据
- '****************************************************************************
- With Sheet19
- endrow = .Cells(.Rows.Count, "A").End(xlUp).Row
- For i = 2 To endrow
- If .Cells(i, "A") = Me.TextBox1.Text Then
- qc = qc + .Cells(i, "C")
- Exit For
- End If
- Next
- End With
- '****************************************************************************
- r = 1
- With Sheet2
- endrow = .Cells(.Rows.Count, "A").End(xlUp).Row
- For i = 2 To endrow
- If .Cells(i, "C") = Me.TextBox1.Text Then
- If .Cells(i, "A") < dt1 Then
- qc = qc + .Cells(i, "I") - .Cells(i, "J")
- ElseIf .Cells(i, "A") >= dt1 And .Cells(i, "A") <= dt2 Then
- r = r + 1
- Sheet13.Cells(r, "A") = .Cells(i, "A") '日期
- Sheet13.Cells(r, "B") = .Cells(i, "C") '往来单位
- Sheet13.Cells(r, "C") = .Cells(i, "E") '摘要
- Sheet13.Cells(r, "D") = .Cells(i, "I") '收入金额
- Sheet13.Cells(r, "E") = .Cells(i, "J") '支出金额
- End If
- End If
- Next
- End With
- '****************************************************************************
- Sheet13.Range("A:E").Sort key1:=Sheet13.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
- OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
- :=xlPinYin, DataOption1:=xlSortNormal
- Range("C5") = "上期结转"
- Range("G5") = qc
- balance = Application.Round(qc, 2)
- rr = 5
- If r > 1 Then
- For i = 2 To r
- rr = rr + 1
- Cells(rr, "A") = Month(Sheet13.Cells(i, "A")) '月
- Cells(rr, "B") = Day(Sheet13.Cells(i, "A")) '日
- Cells(rr, "C") = Sheet13.Cells(i, "B") '往来单位
- Cells(rr, "D") = Sheet13.Cells(i, "C") '摘要
- Cells(rr, "E") = Sheet13.Cells(i, "D") '收入金额
- Cells(rr, "F") = Sheet13.Cells(i, "E") '支出金额
- balance = Application.Round(balance + Cells(rr, "E") - Cells(rr, "F"), 2)
- Cells(rr, "G") = balance
- ljj = ljj + Cells(rr, "E")
- ljd = ljd + Cells(rr, "F")
- jf = jf + Cells(rr, "E")
- df = df + Cells(rr, "F")
- If Year(Sheet13.Cells(i, "A")) <> Year(Sheet13.Cells(i + 1, "A")) Or (Year(Sheet13.Cells(i, "A")) = Year(Sheet13.Cells(i + 1, "A")) And Month(Sheet13.Cells(i, "A")) <> Month(Sheet13.Cells(i + 1, "A"))) Or Sheet13.Cells(i + 1, "A") = "" Then
- rr = rr + 1
- Cells(rr, "A") = VBA.Month(Sheet13.Cells(i, "A")) & "月"
- Cells(rr, "C") = "本月合计" '
- Cells(rr, "G") = balance
- Cells(rr, "E") = jf ' 借方
- Cells(rr, "F") = df ' 贷方
- temps = "a" & rr & ":" & "g" & rr
- Range(temps).Interior.ColorIndex = 34 '本月合计颜色
- rr = rr + 1
- Cells(rr, "A") = VBA.Month(Sheet13.Cells(i, "A")) & "月"
- Cells(rr, "C") = "本年累计" ' 4 摘要
- Cells(rr, "G") = balance
- Cells(rr, "E") = ljj ' 借方
- Cells(rr, "F") = ljd ' 贷方
- temps = "a" & rr & ":" & "g" & rr
- Range(temps).Interior.ColorIndex = 6 '本年累计颜色
- jf = 0
- df = 0
- yf = 0
- End If
- Next
- End If
- Range("A5:G" & rr).Borders.LineStyle = xlContinuous
- Sheet13.Range("A:E").ClearContents
- Unload Me
- Application.ScreenUpdating = True
- End If
- End Sub
- Sub 汇总人民币() '正则用法二
- Dim 数据源 As String, Item As Double '声明变量
- 数据源 = "美元:123元 人民币:44元 英磅:100元 美元:44元 人民币:300.06元" '待计算的字符串
- With CreateObject("VBSCRIPT.REGEXP") '引用正则表达式
- .Global = True '全局匹配
- .Pattern = "人民币:(\d+.(\d+)?)(?=元)" '指定匹配条件
- Set Matches = .Execute(数据源) '执行匹配
- For Each Match In Matches '遍历匹配的结果
- Item = Item + Replace(Match.Value, "人民币:", "") '将“人民币：”替换成空，然后逐一累加
- Next
- MsgBox "人民币合计：" & Item '报告合计结果
- End With
- End Sub
- Function 去除不可见字符(rng As Range)
- Dim ar, i
- ar = Array(9, 10, 13, 28, 29, 30, 31, 32, 127)
- For i = 0 To UBound(ar)
- rng.Replace ChrW(ar(i)), ""
- Next
- For i = 129 To 254
- rng.Replace ChrW(i), ""
- Next
- rng.Replace " ", ""
-
- End Function
- Sub 去重2() '调用系统去重功能 提取不重复项
- Sheet1.Cells.Clear
- Sheet3.Range("A:D").Copy Sheet1.Range("A1")
- Sheet1.UsedRange.RemoveDuplicates _
- Columns:=Array(1, 3), Header:=xlYes
- End Sub
- Private Sub cmd退出_Click()
- Unload Me
- End Sub
- Private Sub CommandButton1_Click()
- rtnRow = 0
- commTableName = "往来单位"
- frmInPut.Show
- If rtnRow > 0 Then
- Me.TextBox1 = Sheet19.Cells(rtnRow, "B")
- End If
- End Sub
- Private Sub txt开始日_AfterUpdate()
- Dim wEndymd As Date
- If IsDate(Me.txt开始日) Then
- Me.txt开始日 = Format(Me.txt开始日, "yyyy-m-d")
- Else
- MsgBox "日期(年/月/日)请输入", vbExclamation + vbOKOnly, "Input Error!"
- Me.txt开始日 = ""
- End If
- End Sub
- Private Sub txt终了日_AfterUpdate()
- If IsDate(Me.txt终了日) Then
- Me.txt终了日 = Format(Me.txt终了日, "yyyy-m-d")
- Else
- MsgBox "日期(年/月/日)请输入", vbExclamation + vbOKOnly, "Input Error!"
- Me.txt终了日 = ""
- End If
- End Sub
- Private Sub cmd开始日Calendar_Click()
- commParamDate = Me.txt开始日
- frmCalendar.Show vbModal
- If IsNull(rtnDate) = False Then
- Me.txt开始日 = rtnDate
- Call txt开始日_AfterUpdate
- End If
- End Sub
- Private Sub cmd终了日Calendar_Click()
- commParamDate = Me.txt终了日
- frmCalendar.Show vbModal
- If IsNull(rtnDate) = False Then
- Me.txt终了日 = rtnDate
- Call txt终了日_AfterUpdate
- End If
- End Sub
- Private Sub UserForm_Activate()
- Me.txt开始日 = Format(DateSerial(Year(Date), Month(Date), 1), "yyyy-m-d")
- Me.txt终了日 = Format(DateSerial(Year(Date), Month(Date) + 1, 0), "yyyy-m-d")
- End Sub
|
|
楼主: 军3008
IP卡
狗仔卡
发表于 2021-12-11 14:49
显身卡
