![复制代码](http://image109.360doc.com/DownloadImg/2021/11/2110/234497869_1_2021112111102152.gif)
Function Get操作NullLine()
'
'从 操作表 获取最后一个有数据下面的空行 row 序号
'
Get操作NullLine = GetNullLine('操作', 'A', 2)
End Function
Function Get预算NullLine()
'
'从 预算表 获取最后一个有数据下面的空行 row 序号
'
Get预算NullLine = GetNullLine('预算', 'A', 5)
End Function
Function Get信息统计NullLine()
Get信息统计NullLine = GetNullLine('信息统计', 'A', 2)
End Function
Function GetNullLine(excelTable As String, fromCell As String, beginRow As Integer)
'
'从 excelTable表 获取[fromCell单元格开始的]最后一个无数据的空行 row 序号
'
'设置开始的行
Dim line: line = beginRow
'选择Excel工作簿
Worksheets(excelTable).Select
'查找空行
For Each c In Worksheets(excelTable).Range(fromCell & beginRow & ':' & fromCell & '999').Cells
If c.Value <> '' Then
'With c.Font
' .Bold = True
' .Italic = True
'End With
'''''''''MsgBox c.Value'查看当前是什么数据
Else
'找到了空行则返回
GetNullLine = line
Exit Function
End If
line = line + 1
Next c
End Function
Sub CreateNewOrderID()
'
' CreateNewOrderID 宏
' 创建单号
'
Sheets('操作').Select
Range('Q1:U1').Select
'单元格格式为文本即可
Selection.NumberFormatLocal = '@'
'设置单元格内容为 订单号,规则= 日期
ActiveCell.FormulaR1C1 = Year(Now()) & Month(Now()) & Day(Now()) & Hour(Now()) & Minute(Now()) & Second(Now())
End Sub
'
'遍历 操作表 中的一行序号,每一个序号都进行 DealSelectData(str) 处理,失败,则提示
'
Function DealRowDatas(n As Integer) As Boolean
DealRowDatas = False
If n < 0 Then MsgBox '错误的参数 n=-1': Exit Function '判断传参错误
If Not DealSelectData(Worksheets('操作').Range('A' & n).Value) Then MsgBox '处理这行数据错误:【' & 'A' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('B' & n).Value) Then MsgBox '处理这行数据错误:【' & 'B' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('C' & n).Value) Then MsgBox '处理这行数据错误:【' & 'C' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('D' & n).Value) Then MsgBox '处理这行数据错误:【' & 'D' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('E' & n).Value) Then MsgBox '处理这行数据错误:【' & 'E' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('F' & n).Value) Then MsgBox '处理这行数据错误:【' & 'F' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('G' & n).Value) Then MsgBox '处理这行数据错误:【' & 'G' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('H' & n).Value) Then MsgBox '处理这行数据错误:【' & 'H' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('I' & n).Value) Then MsgBox '处理这行数据错误:【' & 'I' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('J' & n).Value) Then MsgBox '处理这行数据错误:【' & 'J' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('K' & n).Value) Then MsgBox '处理这行数据错误:【' & 'K' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('L' & n).Value) Then MsgBox '处理这行数据错误:【' & 'L' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('M' & n).Value) Then MsgBox '处理这行数据错误:【' & 'M' & n & '】': Exit Function
If Not DealSelectData(Worksheets('操作').Range('N' & n).Value) Then MsgBox '处理这行数据错误:【' & 'N' & n & '】': Exit Function
DealRowDatas = True
End Function
'
'根据一个字符串 比如 DM9 从总表 查询并拷贝到 预算表 中去
'
Function DealSelectData(str As String) As Boolean
DealSelectData = False
'MsgBox '从总表中查询[' & str & ']并且添加到 预算表 中去'
'str= 'Range('A3').Select
'str= 'ActiveCell.FormulaR1C1 = 'DM9'
Sheets('总表').Select
Dim findObj As Range
Set findObj = Cells.Find(What:=str, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False)
findObj.Activate
findObj.Select
'MsgBox findObj.Column
Dim findRow As Integer: findRow = findObj.Row
'项目名称 辅材:元/单位 数量 人工:元/单位 数量 金额(元) 工艺做法及材料说明
'拷贝以上列数据 在总表中 B-H 列的数据
Range('B' & findRow & ':H' & findRow).Select
Selection.Copy
Sheets('预算').Select
'从预算表中第几行开始粘贴
Dim targetRow: targetRow = Get预算NullLine()
Range('A' & targetRow).Select
ActiveSheet.Paste
Sheets('操作').Select
DealSelectData = True
End Function
Sub Copy操作To信息统计(fromStr As String, toStr As String)
'从一个单元格拷贝到另一个单元格
Sheets('操作').Select
Range(fromStr).Select
'MsgBox ActiveCell.Value'测试单元格是什么值
'ActiveCell.FormulaR1C1 = '2015215104319'
ActiveCell.Copy
'Selection.Copy
Sheets('信息统计').Select
Range(toStr).Select
'ActiveSheet.Paste'此粘贴包含了格式,不好用!!!!!
'只粘贴值,不粘贴格式
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
'
'0 【增加到预算按钮】把操作表 最后一行的每一列的类似 DM9 这样的数据,从总表查询出来,拷贝到预算中去
'
Sub 增加到预算()
Application.ScreenUpdating = False
Call CreateNewOrderID
If Not DealRowDatas(Get操作NullLine() - 1) Then: MsgBox '增加到预算 失败!有错误,请联系管理员 ': Application.ScreenUpdating = True: Exit Sub
Sheets('预算').Select
Application.ScreenUpdating = True
Exit Sub
End Sub
'
' 1 【保存到信息统计中】
'
Sub 保存到信息统计()
Application.ScreenUpdating = False
Dim emptyLineNo: emptyLineNo = Get信息统计NullLine()
'单号
Call Copy操作To信息统计('Q1:U1', 'A' & emptyLineNo)
'预算员
Call Copy操作To信息统计('Q6:U6', 'B' & emptyLineNo)
'业主姓名
Call Copy操作To信息统计('Q2:U2', 'C' & emptyLineNo)
'联系方式
Call Copy操作To信息统计('Q3:U3', 'D' & emptyLineNo)
'家庭地址
Call Copy操作To信息统计('Q4:U4', 'E' & emptyLineNo)
'施工地址
Call Copy操作To信息统计('Q5:U5', 'F' & emptyLineNo)
Sheets('操作').Select
Application.CutCopyMode = False
Sheets('信息统计').Select
Application.ScreenUpdating = True
Exit Sub
End Sub
![复制代码](http://image109.360doc.com/DownloadImg/2021/11/2110/234497869_1_2021112111102152.gif)
|