审计结算单批量生成
审计结算单批量生成
数据操作主要代码
Sub QH_A_01(quehui) '1.新建表格
If quehui <> "阙辉" Then Exit Sub
' Unload UserForm1
Dim o As Integer, sht As Worksheet
o = 15
Set sht = Worksheets("总表")
Do While sht.Cells(o, "a") <> ""
On Error Resume Next
If Worksheets(sht.Cells(o, "a").Value) Is Nothing Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sht.Cells(o, "a").Value
End If
o = o + 1
Loop
Sheets("总表").Activate
'UserForm1.CommandButton1.Locked = True
' UserForm1.Show
End Sub
Sub QH_A_02(quehui) '2.添加标题
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim ax1, ax2 As Long
ax2 = Sheets.Count
For ax1 = 1 To ax2
If Sheets(ax1).Name <> "总表" And Sheets(ax1).Name <> "城市" Then
Sheets("总表").Range("a12:j14").Copy Sheets(ax1).Range("a1")
End If
Next
' UserForm1.CommandButton2.Locked = True
' UserForm1.Show
End Sub
Sub QH_A_03(quehui) '3.拆分数据
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim i As Long, bj As String, rng As Range
i = 15
bj = Sheets("总表").Cells(i, "a").Value
Do While bj <> ""
Set rng = Worksheets(bj).Range("a1000000").End(xlUp).Offset(1, 0)
Cells(i, "a").Resize(1, 25).Copy rng
i = i + 1
bj = Sheets("总表").Cells(i, "a").Value
Loop
' UserForm1.CommandButton3.Locked = True
' UserForm1.Show
End Sub
Sub QH_A_04(quehui) '4.添加表尾
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim ax3, ax4, ax5 As Long
ax4 = Sheets.Count
For ax3 = 1 To ax4
If Sheets(ax3).Name <> "总表" And Sheets(ax3).Name <> "城市" Then
ax5 = Sheets(ax3).Range("a1000000").End(xlUp).row
Sheets("总表").Range("a1:j11").Copy Sheets(ax3).Range("a" & ax5 + 2)
End If
Next
' UserForm1.CommandButton4.Locked = True
' UserForm1.Show
End Sub
Sub QH_A_05(quehui) '5.设置表格格式
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim ax6, ax7, ax8 As Long
ax7 = Sheets.Count
For ax6 = 1 To ax7
If Sheets(ax6).Name <> "总表" And Sheets(ax6).Name <> "城市" Then
With Sheets(ax6)
ax8 = .Range("a100000").End(xlUp).row
.Range("a:a").ColumnWidth = 23.5
.Range("b:b").ColumnWidth = 16.88
.Range("c:c").ColumnWidth = 12.5
.Range("d:d").ColumnWidth = 16
.Range("e:e").ColumnWidth = 14.5
.Range("f:f").ColumnWidth = 14.5
.Range("g:g").ColumnWidth = 14.5
.Range("h:h").ColumnWidth = 14.5
.Range("i:i").ColumnWidth = 11
.Range("j:j").ColumnWidth = 13.88
.Range("a:a").NumberFormatLocal = "@"
.Range("b:b").NumberFormatLocal = "@"
.Range("c:c").NumberFormatLocal = "@"
.Range("d:d").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("e:e").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("f:f").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("g:g").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("h:h").NumberFormatLocal = "#,##0.00_ ;[红色]-#,##0.00 "
.Range("j:j").NumberFormatLocal = "@"
.Range("j:j").NumberFormatLocal = "@"
.Range("c" & ax8 - 8).NumberFormatLocal = "G/通用格式"
.Cells(ax8 - 8, 3) = "=count(i4:i" & ax8 - 12 & ")"
.Cells(ax8 - 8, 4) = "=sum(d4:d" & ax8 - 12 & ")"
' .Cells(ax8 - 8, 5) = "=sumif(i4:i" & ax8 - 12 & ",i" & ax8 - 8 & ",e4:e" & ax8 - 12 & ")"
' .Cells(ax8 - 8, 6) = "=sumif(i4:i" & ax8 - 12 & ",i" & ax8 - 8 & ",f4:f" & ax8 - 12 & ")"
' .Cells(ax8 - 8, 7) = "=sumif(i4:i" & ax8 - 12 & ",i" & ax8 - 8 & ",g4:g" & ax8 - 12 & ")"
' .Cells(ax8 - 8, 8) = "=sumif(i4:i" & ax8 - 12 & ",i" & ax8 - 8 & ",h4:h" & ax8 - 12 & ")"
.Cells(ax8 - 8, 5) = "=sum(e4:e" & ax8 - 12 & ")"
.Cells(ax8 - 8, 6) = "=sum(f4:f" & ax8 - 12 & ")"
.Cells(ax8 - 8, 7) = "=sum(g4:g" & ax8 - 12 & ")"
.Cells(ax8 - 8, 8) = "=sum(h4:h" & ax8 - 12 & ")"
With .Range("a4:j" & ax8 - 11) '设置打印边框 7
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
End With
End If
Next
' UserForm1.CommandButton5.Locked = True
' UserForm1.Show
End Sub
Sub QH_A_06(quehui) '6.设置打印格式
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim ax9, ax10, ax11, ax12 As Long
ax10 = Sheets.Count
For ax9 = 1 To ax10
If Sheets(ax9).Name <> "总表" And Sheets(ax9).Name <> "城市" Then
With Sheets(ax9)
ax11 = .Range("a100000").End(xlUp).row
ax12 = .Range("iv" & 3).End(xlToLeft).Column
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(ax11, ax12)).Address '打印区域 3
.PageSetup.Orientation = xlLandscape '打印方向 4
.PageSetup.PrintTitleRows = .Rows("1:3").Address '打印标题 5
.PageSetup.CenterHorizontally = True '水平居中 6
.PageSetup.Zoom = 80 '设置缩放比例
.PageSetup.LeftMargin = Application.InchesToPoints(0)
.PageSetup.RightMargin = Application.InchesToPoints(0)
End With
End If
Next
'UserForm1.CommandButton6.Locked = True
'UserForm1.Show
End Sub
Sub QH_A_07(quehui) '7.还原表的名称
If quehui <> "阙辉" Then Exit Sub
Dim ax31, ax32, ax33, ax34, ax35, ax36 As Long
ax32 = Sheets.Count
ax34 = Sheets("城市").Range("b100000").End(xlUp).row
For ax31 = 1 To ax32
If Sheets(ax31).Name <> "总表" And Sheets(ax31).Name <> "城市" Then
With Sheets(ax31)
qwe1 = .Name
ax33 = .Range("a100000").End(xlUp).row
For ax35 = 2 To ax34
If Sheets("城市").Cells(ax35, 2) = qwe1 Then
.Range("a4:a" & ax33 - 12) = Sheets("城市").Cells(ax35, 4)
End If
Next ax35
End With
End If
Next ax31
End Sub
Sub QH_A_08(quehui) '8.更改表的名称
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim ax13, ax14, ax15, ax16, ax17, ax18 As Long
ax14 = Sheets.Count
ax16 = Sheets("城市").Range("b100000").End(xlUp).row
myarry1 = Sheets("城市").Range("b1:c" & ax16)
For ax13 = 1 To ax14
If Sheets(ax13).Name <> "总表" And Sheets(ax13).Name <> "城市" Then
With Sheets(ax13)
ax18 = ax18 + 1
asc1 = .Name
asc2 = WorksheetFunction.VLookup(asc1, myarry1, 2, 0)
ax15 = .Range("a100000").End(xlUp).row
ax17 = .Cells(ax15 - 8, 5) + .Cells(ax15 - 8, 7)
.Name = ax18 & asc2 & "-" & "18QH" & asc1 & "-" & ax17
End With
End If
Next
'UserForm1.CommandButton7.Locked = True
'UserForm1.Show
End Sub
Sub QH_A_09(quehui) '9.拆分工作簿
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim sht As Worksheet
Application.ScreenUpdating = False
ipath = ThisWorkbook.Path & "\"
For Each sht In Sheets
If sht.Name <> "总表" And sht.Name <> "城市" Then
sht.Copy
On Error Resume Next
Kill ipath & sht.Name & ".xlsx"
ActiveWorkbook.SaveAs ipath & sht.Name & ".xlsx" '(工作表名称为文件名）
'ActiveWorkbook.SaveAs ipath & sht.Name & Trim(sht.[d15]) & ".xls" '（文件名称 & D15单元内容）
'ActiveWorkbook.SaveAs ipath & Trim(sht.[d15]) & ".xls" '（文件名称为D15单元内容）
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True
'UserForm1.CommandButton8.Locked = True
'UserForm1.Show
End Sub
Sub QH_A_10(quehui) '10回到总表
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Sheets("总表").Activate
'UserForm1.Show
End Sub
Sub QH_A_11(quehui) '11.检查表名
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim ax21, ax22, ax23, ax24 As Long
ax22 = Sheets.Count
ax23 = 3
For ax21 = 1 To ax22
If Sheets(ax21).Name <> "总表" And Sheets(ax21).Name <> "城市" Then
With Sheets(ax21)
Sheets("城市").Cells(ax23, 7) = .Name
ax23 = ax23 + 1
End With
End If
Next
' UserForm1.Show
End Sub
Sub QH_A_15(quehui) '15.删除重置
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim sht As Worksheet
Application.ScreenUpdating = False
Application.ScreenUpdating = False '屏蔽提示窗口
Application.DisplayAlerts = False '屏蔽提示窗口
Application.CutCopyMode = False '去唯一 阙辉
ipath = ThisWorkbook.Path & "\"
For Each sht In Sheets
If sht.Name <> "总表" And sht.Name <> "城市" Then
' sht.Copy
' On Error Resume Next
' Kill ipath & sht.Name & ".xlsx"
' ActiveWorkbook.SaveAs ipath & sht.Name & ".xlsx" '(工作表名称为文件名）
' 'ActiveWorkbook.SaveAs ipath & sht.Name & Trim(sht.[d15]) & ".xls" '（文件名称 & D15单元内容）
' 'ActiveWorkbook.SaveAs ipath & Trim(sht.[d15]) & ".xls" '（文件名称为D15单元内容）
' ActiveWorkbook.Close
sht.Delete
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True '恢复提示窗口
Application.ScreenUpdating = True '恢复提示窗口
Application.CutCopyMode = True
'UserForm1.CommandButton8.Locked = True
'UserForm1.Show
End Sub
Sub QH_A_16(quehui) '16.换项目名称
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim ax13, ax14, ax15, ax16, ax17, ax18 As Long
ax14 = Sheets("总表").Range("b1000000").End(xlUp).row
ax16 = Sheets("城市").Range("b100000").End(xlUp).row
myarry1 = Sheets("城市").Range("d1:e" & ax16)
For ax13 = 15 To ax14
With Sheets("总表")
asc1 = .Cells(ax13, 1)
.Cells(ax13, 1) = WorksheetFunction.VLookup(asc1, myarry1, 2, 0)
End With
Next
'UserForm1.CommandButton7.Locked = True
'UserForm1.Show
End Sub
Function QH_A_17(qh_sheet, qh_shi, qh_lie As Long) '17检查是否唯一
Dim qh_range_lie As String
Dim qh_range_ROW_0 As Long
qh_range_lie = GetColumnLetter(qh_lie)
qh_range_lie1 = 0
qh_range_ROW_0 = qh_shi
With Sheets(qh_sheet)
ax33 = .Range(qh_range_lie & "100000").End(xlUp).row
For i = qh_range_ROW_0 To ax33
.Cells(i, 6) = Application.CountIf(.Range(qh_range_lie & qh_range_ROW_0 & ":" & qh_range_lie & ax33), .Range(qh_range_lie & i))
qh_range_lie1 = qh_range_lie1 + Application.CountIf(.Range(qh_range_lie & qh_range_ROW_0 & ":" & qh_range_lie & ax33), .Range(qh_range_lie & i))
Next i
End With
If qh_range_lie1 + 2 = ax33 Then
QH_A_17 = "没有重复QH"
Else
QH_A_17 = "有重复QH"
End If
End Function
Sub QH_A_18(quehui) '18.换项目名称
If quehui <> "阙辉" Then Exit Sub
'Unload UserForm1
Dim ax13, ax14, ax15, ax16, ax17, ax18 As Long
ax14 = Sheets("城市").Range("b1000000").End(xlUp).row
ax16 = Sheets("总表").Range("b1000000").End(xlUp).row
myarry1 = Sheets("总表").Range("a1:j" & ax16)
For ax13 = 3 To ax14
With Sheets("城市")
asc1 = .Cells(ax13, 2)
.Cells(ax13, 3) = WorksheetFunction.VLookup(asc1, myarry1, 10, 0)
End With
Next
'UserForm1.CommandButton7.Locked = True
'UserForm1.Show
End Sub
Sub QH16101104(阙辉) '暂时锁住 这个是恢复开发商名称
Dim ax31, ax32, ax33, ax34, ax35, ax36 As Long
ax32 = Sheets.Count
ax34 = Sheets("城市").Range("b100000").End(xlUp).row
For ax31 = 1 To ax32
If Sheets(ax31).Name <> "总表" And Sheets(ax31).Name <> "城市" Then
With Sheets(ax31)
qwe1 = .Name
ax33 = .Range("a100000").End(xlUp).row
For ax35 = 2 To ax34
If Sheets("城市").Cells(ax35, 2) = qwe1 Then
.Range("a2") = "甲方名称：" & Sheets("城市").Cells(ax35, 5).Value
End If
Next ax35
End With
End If
Next ax31
End Sub
Public Sub qh_qu_wei_yi(qh_sheet, qh_shi, qh_lie As Long) '数据去唯一
Dim qh_AAA As String
Dim qh_s_z As Long
Application.ScreenUpdating = False
Application.ScreenUpdating = False '屏蔽提示窗口
Application.DisplayAlerts = False '屏蔽提示窗口
Application.CutCopyMode = False '去唯一 阙辉
qh_AAA = GetColumnLetter(qh_lie)
With Sheets(qh_sheet)
qh_s_z = .Range(qh_AAA & "100000").End(xlUp).row
On Error Resume Next
.Range("$" & qh_AAA & "$" & qh_shi & ":$" & qh_AAA & "$" & qh_s_z).RemoveDuplicates Columns:=1, Header:=xlNo '去唯一 阙辉
.Range("$" & qh_AAA & "$" & qh_shi).Select
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True '恢复提示窗口
Application.ScreenUpdating = True '恢复提示窗口
Application.CutCopyMode = True
End Sub
Sub qh_qu_san(qh_sheet, qh_shi, qh_lie As Long) '取前三个字
Dim qh_range_lie As String
Dim qh_range_ROW_0 As Long
qh_range_lie = GetColumnLetter(qh_lie)
qh_range_lie1 = GetColumnLetter(qh_lie + 1)
qh_range_ROW_0 = qh_shi
With Sheets(qh_sheet)
ax33 = .Range(qh_range_lie & "100000").End(xlUp).row
For i = qh_range_ROW_0 To ax33
aa = .Range(qh_range_lie & i)
.Range(qh_range_lie1 & i) = Left(aa, 3)
Next i
End With
End Sub
Sub qh_qu_chong(qh_sheet, qh_shi, qh_lie As Long) '不唯一的加序列
Dim qh_range_lie As String
Dim qh_range_ROW_0 As Long
qh_range_lie = GetColumnLetter(qh_lie)
qh_range_lie1 = GetColumnLetter(qh_lie - 3)
qh_range_ROW_0 = qh_shi
With Sheets(qh_sheet)
ax33 = .Range(qh_range_lie & "100000").End(xlUp).row
For i = qh_range_ROW_0 To ax33
If Application.CountIf(.Range(qh_range_lie & qh_range_ROW_0 & ":" & qh_range_lie & ax33), .Range(qh_range_lie & i)) > 1 Then
For j = qh_range_ROW_0 To ax33
If .Range(qh_range_lie & j) = .Range(qh_range_lie & i) Then
.Range(qh_range_lie & j) = .Range(qh_range_lie & j) & j
.Range(qh_range_lie1 & j) = .Range(qh_range_lie & j)
End If
Next j
Else
.Range(qh_range_lie1 & i) = .Range(qh_range_lie & i)
End If
Next i
End With
End Sub
浙公网安备 33010602011771号