请问如何用ExcelVBA语言实现把表2符合条件内容自动添加到表1最后一个空行内？

Question

例如：当表1记录不满13个时，此时自动将表2的第23行第1列数据添加到表1第13行第2列中，当表1记录再次不满13条时，自动将表2的第24行第1列符合“在职”条件的数据添加到表1第13行第2列中，以此类推，但当表2的第25行第2列为“离职”时自动跳过第25行数据，而是将第26行符合“在职”状态的数据添加到表1第13行第2列中。请问大咖如何编写VBA语言？

Answer 1

复制到 表1
Sub AA()
Dim I
X = Range("A65536").End(xlUp).Row
If X < 13 Then
[AA1] = Sheets("表2").[A24]
N = WorksheetFunction.Match([AA1], Sheets("表2").Range("A:A"), 0)
End If
For I = N + 1 To Sheets("表2").Range("A65536").End(xlUp).Row
If Sheets("表2").Cells(I, "b") = "在职" Then
[B13] = Sheets("表2").Cells(I, "a")
[C13] = Sheets("表2").Cells(I, "B")
Exit For
End If
Next
End Sub追问

请问老师为什么要加 [AA1] = Sheets("表2").[A24]这段代码，加这段代码的意义是什么？麻烦老师再写段代码。条件是：当“表1”达到13条记录后，禁止将“表2”符合条件的数据添加到“表1”中。

追答

Sub AA()
If [AA1] = "" Then
[AA1] = Sheets("表2").[A23] '从表2，第23行开始获取数据到AA列，作为曾经的记录
End If
Dim I
X = Range("B65536").End(xlUp).Row
If X < 13 Then '如果表1记录不满13个时
Y = Range("AA65536").End(xlUp).Row
N = WorksheetFunction.Match(Cells(Y, "AA"), Sheets("表2").Range("A:A"), 0) '判断最后1个记录在表2的位置
End If
For I = N + 1 To Sheets("表2").Range("A65536").End(xlUp).Row '从这个位置下一行开始循环，
If Sheets("表2").Cells(I, "b") = "在职" Then '且B列是 在职
[B13] = Sheets("表2").Cells(I, "a") '表2 数据写入B13
[C13] = Sheets("表2").Cells(I, "B") '表2 数据写入C13
Cells(Y + 1, "AA") = [B13] 'AA更新B13的数据记录
Exit For '退出循环
End If
Next
End Sub
你试下

追问

N = WorksheetFunction.Match(Cells(Y, "AA"), Sheets("表2").Range("A:A")这段程序在运行时出现错误，提示“不能取得类WorksheetFunction的Match属性”望老师指教修改。

追答

表2的A列数据，不能删除
我修改下，避免这个错误
Sub AA()
If [AA1] = "" Then
[AA1] = Sheets("表2").[A23] '从表2，第23行开始获取数据到AA列，作为曾经的记录
[AB1] = 24 '获取行号
[B13] = Sheets("表2").[A23] '表2 数据写入B13
[C13] = Sheets("表2").[B23] '表2 数据写入C13
End If
Dim I
X = Range("B65536").End(xlUp).Row
If X < 13 Then '如果表1记录不满13个时
y = Range("AB65536").End(xlUp).Row
N = Cells(y, "aB") + 1 '判断最后1个记录在表2的位置
MsgBox "从 表2 第：" & N & "行，向下查找最近的一个 在职 人员"

For I = N + 1 To Sheets("表2").Range("A65536").End(xlUp).Row '从这个位置下一行开始循环，
If Sheets("表2").Cells(I, "b") = "在职" Then '且B列是 在职
[B13] = Sheets("表2").Cells(I, "a") '表2 数据写入B13
[C13] = Sheets("表2").Cells(I, "B") '表2 数据写入C13
Cells(y + 1, "AA") = [B13] 'AA更新B13的数据记录
Cells(y + 1, "AB") = I
Exit For '退出循环
End If

Next
End If
End Sub

追问

首先再次感谢老师！我还有个最后问题。就是：当按下“开始”按钮控件后页面自动刷新并将“开始”字符改为“停止”字符。当按下“停止”后停止刷新并把“停止”字符改为“开始”字符。请问如何用代码写出来。急用。谢谢老师了。

追答

不明白你意思

追问

不好意思，刚看到你的答复。

我的意思是当按

这个按钮后，“开始”字符就自动改为“停止”字符。以此类推。请问VBA怎么编写？

追答

你要 按钮，修改名称？
Sub 修改按钮名()
ActiveSheet.Shapes("Button 4").Select '根据实际 修改 Button 4 这个名称
If Selection.Characters.Text = "开始" Then
Selection.Characters.Text = "停止"
Else
Selection.Characters.Text = "开始"
End If
End Sub
Sub AA()
修改按钮名
Dim I
x = Range("A65536").End(xlUp).Row
If x < 13 Then
[AA1] = Sheets("表2").[A24]
N = WorksheetFunction.Match([AA1], Sheets("表2").Range("A:A"), 0)
End If
For I = N + 1 To Sheets("表2").Range("A65536").End(xlUp).Row
If Sheets("表2").Cells(I, "b") = "在职" Then
[B13] = Sheets("表2").Cells(I, "a")
[C13] = Sheets("表2").Cells(I, "B")
Exit For
End If
Next
End Sub

追问

老师，你好，“ActiveSheet.Shapes("Button 4").Select”这段代码在运行过程中出现了错误显示。原因是因为我在设计过程中采用了“插入→矩形→圆角矩形“方式来设计按钮的，所以"Button 4"就不存在了，请问老师“圆角矩形”这个图形是用什么语句来表达的？

追答

你就录制宏，把这个过程记录下来
查看，里面的代码，就是这个 对象的名称

追问

我录制的宏是设置“圆角矩形”的格式，但代码里没有“圆角矩形”的对象名称

追答

你这个问题，都给你整复杂了（哈哈）