Sub Macro1() Dim erow As Integer, Fsbill As String, r As Variant erow = Sheets("汇总").[a65536].End(xlUp).Row + 1 Fsbill = Range("i7") If Application.CountIf(Sheets("汇总").Range("c:c"), Fsbill) > 0 Then MsgBox "采购单号" & Fsbill & " was already exists !!!!" Exit Sub End If For r = 19 To 24 If Cells(r, 2) <> "" Then Sheets("汇总").Cells(erow, 1) = Month(Cells(8, 9)) Sheets("汇总").Cells(erow, 2) = Cells(8, 9) Sheets("汇总").Cells(erow, 3) = Cells(7, 9) Sheets("汇总").Cells(erow, 4) = Cells(7, 3) Sheets("汇总").Cells(erow, 5) = Cells(9, 9) Sheets("汇总").Cells(erow, 6) = Cells(10, 9) Sheets("汇总").Cells(erow, 7) = Cells(r, 2) Sheets("汇总").Cells(erow, 8) = Cells(r, 4) Sheets("汇总").Cells(erow, 9) = Cells(r, 5) Sheets("汇总").Cells(erow, 10) = Cells(r, 6) Sheets("汇总").Cells(erow, 11) = Cells(r, 7) Sheets("汇总").Cells(erow, 12) = Cells(r, 8) erow = erow + 1 End If Next Sheets("汇总").Select MsgBox "OK" End Sub这段VBA代码的作用
时间: 2024-01-07 14:06:12 浏览: 21
这段VBA代码的作用是将一个表格中指定区域的数据复制到另一个表格中,并在复制数据的同时进行一些条件判断和数据处理。具体包括以下几个步骤:
1. 获取目标表格的插入行数,使新数据可以添加到表格的末尾。
2. 获取源表格中指定单元格的值,用于后面判断采购单号是否已存在。
3. 判断采购单号是否已存在于目标表格中,如果存在则弹出提示信息并退出代码。
4. 遍历源表格中指定的行,对于每一行,如果第二列不为空,则将该行的数据复制到目标表格的指定列中。
5. 将目标表格切换到“汇总”表格,并弹出提示信息“OK”。
总体来说,这段代码实现了将源表格中指定区域的数据复制到目标表格中,并在复制的过程中进行一些数据处理和条件判断。
相关问题
Sub Macro1() Dim erow As Integer, Fsbill As String, r As Variant erow = Sheets("汇总").[a65536].End(xlUp).Row + 1 Fsbill = Range("i7") If Application.CountIf(Sheets("汇总").Range("c:c"), Fsbill) > 0 Then MsgBox "采购单号" & Fsbill & " was already exists !!!!" Exit Sub End If For r = 19 To 24 If Cells(r, 2) <> "" Then Sheets("汇总").Cells(erow, 1) = Month(Cells(8, 9)) Sheets("汇总").Cells(erow, 2) = Cells(8, 9) Sheets("汇总").Cells(erow, 3) = Cells(7, 9) Sheets("汇总").Cells(erow, 4) = Cells(7, 3) Sheets("汇总").Cells(erow, 5) = Cells(9, 9) Sheets("汇总").Cells(erow, 6) = Cells(10, 9) Sheets("汇总").Cells(erow, 7) = Cells(r, 2) Sheets("汇总").Cells(erow, 8) = Cells(r, 4) Sheets("汇总").Cells(erow, 9) = Cells(r, 5) Sheets("汇总").Cells(erow, 10) = Cells(r, 6) Sheets("汇总").Cells(erow, 11) = Cells(r, 7) Sheets("汇总").Cells(erow, 12) = Cells(r, 8) erow = erow + 1 End If Next Sheets("汇总").Select MsgBox "OK" End Sub这段VBA代码的作用,并详细分析每一行代码的作用
这段VBA代码的作用是将一个采购单的信息汇总到一个名为“汇总”的工作表中。具体来说,它首先检查采购单号是否已经存在于汇总工作表中,如果是,则弹出消息框并退出子程序。否则,它将从原始采购单中提取必要的信息,并将其写入汇总工作表中。
现在,我们逐行分析每一行代码的作用:
1. Dim erow As Integer, Fsbill As String, r As Variant
这一行定义了三个变量,“erow”表示下一个要写入的行号,“Fsbill”表示采购单号,“r”表示原始采购单中的行号。
2. erow = Sheets("汇总").[a65536].End(xlUp).Row + 1
这一行确定了下一个要写入的行号。它首先找到最后一个非空单元格的行号,然后将其加一。
3. Fsbill = Range("i7")
这一行将采购单号保存为一个字符串变量。
4. If Application.CountIf(Sheets("汇总").Range("c:c"), Fsbill) > 0 Then
这一行使用CountIf函数检查汇总工作表中是否已经存在具有相同采购单号的记录。
5. MsgBox "采购单号" & Fsbill & " was already exists !!!!" Exit Sub
如果存在具有相同采购单号的记录,则显示一个消息框并退出子程序。
6. For r = 19 To 24
这一行循环遍历原始采购单中的行号,这些行包含必要的信息。
7. If Cells(r, 2) <> "" Then
这一行检查原始采购单中当前行是否包含必要的信息。
8. Sheets("汇总").Cells(erow, 1) = Month(Cells(8, 9))
这一行将汇总表中的“月份”列设置为采购单中的月份。
9. Sheets("汇总").Cells(erow, 2) = Cells(8, 9)
这一行将汇总表中的“日期”列设置为采购单中的日期。
10. Sheets("汇总").Cells(erow, 3) = Cells(7, 9)
这一行将汇总表中的“供应商”列设置为采购单中的供应商。
11. Sheets("汇总").Cells(erow, 4) = Cells(7, 3)
这一行将汇总表中的“采购员”列设置为采购单中的采购员。
12. Sheets("汇总").Cells(erow, 5) = Cells(9, 9)
这一行将汇总表中的“部门”列设置为采购单中的部门。
13. Sheets("汇总").Cells(erow, 6) = Cells(10, 9)
这一行将汇总表中的“项目”列设置为采购单中的项目。
14. Sheets("汇总").Cells(erow, 7) = Cells(r, 2)
这一行将汇总表中的“物料名称”列设置为采购单中的物料名称。
15. Sheets("汇总").Cells(erow, 8) = Cells(r, 4)
这一行将汇总表中的“单位”列设置为采购单中的单位。
16. Sheets("汇总").Cells(erow, 9) = Cells(r, 5)
这一行将汇总表中的“数量”列设置为采购单中的数量。
17. Sheets("汇总").Cells(erow, 10) = Cells(r, 6)
这一行将汇总表中的“单价”列设置为采购单中的单价。
18. Sheets("汇总").Cells(erow, 11) = Cells(r, 7)
这一行将汇总表中的“总价”列设置为采购单中的总价。
19. Sheets("汇总").Cells(erow, 12) = Cells(r, 8)
这一行将汇总表中的“备注”列设置为采购单中的备注。
20. erow = erow + 1
这一行将下一个要写入的行号加一,以准备写入下一条记录。
21. End If
这一行结束了if语句块,表示完成了当前行的处理。
22. Next
这一行结束了for循环,表示已经处理完原始采购单中的所有行。
23. Sheets("汇总").Select
这一行将汇总工作表设置为当前激活的工作表。
24. MsgBox "OK"
这一行显示一个消息框,表示成功完成了子程序。
/** * Katana1994 Macro */ function Katana1994() { Dim doc1 As Document Dim rng As Range Dim chapterStart As Long Dim chapterEnd As Long Dim chapterTitle As String Dim chapterIndex As Integer Dim newDoc As Document Set doc1 = ActiveDocument chapterIndex = 1 ' 遍历文档的每个段落 For i = 1 To doc.Paragraphs.Count Set rng = doc.Paragraphs(i).Range ' 检查段落是否为章节标题 If rng.Text Like "第*篇*" Or rng.Text Like "*、*" Then If chapterStart > 0 Then chapterEnd = rng.Start - 1 ' 选中章节内容 doc.Range(chapterStart, chapterEnd).Select ' 复制章节内容 Selection.Copy ' 创建新文档并粘贴章节内容 Set newDoc = Documents.Add newDoc.Content.Paste ' 保存新文档 newDoc.SaveAs "Chapter" & chapterIndex & " - " & chapterTitle & ".docx" newDoc.Close chapterIndex = chapterIndex + 1 End If ' 更新章节标题和起始位置 chapterTitle = rng.Text chapterStart = rng.End End If Next i } 纠正代码
这段代码有一些错误,需要进行一些修改:
1. 定义的过程名为 Katana1994(),但是在代码中使用了 doc 变量,应该将其改为 doc1。
2. 在 For 循环中,应该使用 doc1.Paragraphs.Count 而不是 doc.Paragraphs.Count。
3. 在 If 语句中,应该使用 rng.Text Like "第*篇*" 或者 rng.Text Like "*、*",而不是将它们写在一起。
4. 在创建新文档时,应该使用 Documents.Add() 而不是 Documents.Add。
5. 在保存新文档时,应该将文件名中的章节标题改为 chapterTitle。
修改后的代码如下:
```
Sub Katana1994()
Dim doc1 As Document
Dim rng As Range
Dim chapterStart As Long
Dim chapterEnd As Long
Dim chapterTitle As String
Dim chapterIndex As Integer
Dim newDoc As Document
Set doc1 = ActiveDocument
chapterIndex = 1
For i = 1 To doc1.Paragraphs.Count
Set rng = doc1.Paragraphs(i).Range
If rng.Text Like "第*篇*" Or rng.Text Like "*、*" Then
If chapterStart > 0 Then
chapterEnd = rng.Start - 1
doc1.Range(chapterStart, chapterEnd).Select
Selection.Copy
Set newDoc = Documents.Add()
newDoc.Content.Paste
newDoc.SaveAs "Chapter" & chapterIndex & " - " & chapterTitle & ".docx"
newDoc.Close
chapterIndex = chapterIndex + 1
End If
chapterTitle = rng.Text
chapterStart = rng.End
End If
Next i
End Sub
```