![最好使用 if/when 样式条件来自动化单元格移动](https://linux22.com/image/1469388/%E6%9C%80%E5%A5%BD%E4%BD%BF%E7%94%A8%20if%2Fwhen%20%E6%A0%B7%E5%BC%8F%E6%9D%A1%E4%BB%B6%E6%9D%A5%E8%87%AA%E5%8A%A8%E5%8C%96%E5%8D%95%E5%85%83%E6%A0%BC%E7%A7%BB%E5%8A%A8.png)
我想要完全自动化清理导出数据的过程。我想要:
- 将溢出行中的数据移至其预期列中。我在 VB 中尝试了以下代码。(这是尝试识别电子邮件中的 @ 符号并分别将所有电子邮件地址向右移动两个位置)。
子 qwerty()
Dim D 作为范围,r 作为范围
设置 D = Intersect(ActiveSheet.UsedRange, Range("D:D"))
For Each r In D
If Left(r.Text, 2) = "@" Then
r.Copy r.Offset(0, 1)
r.Clear
End If
Next r End Sub
- 一旦数据位于正确的列中,我需要自动将其移动到正确的行中。我可以轻松地将它们上移,但如果一个联系人没有电子邮件地址(例如),那么当它们上移时,电子邮件将位于错误的行中。
答案1
使用此代码:
Sub qwerty()
Dim y As Integer, x As Integer
y = 2
Do Until Cells(y, 4) = ""
If Cells(y, 3) = "" Then
Select Case Left(Cells(y, 4))
Case "[E": x = 6
Case "[H": x = 7
Case "[M": x = 8
Case "[A": x = 9
Else: x = 10
End Select
Cells(y - 1, x) = Cells(y, 4)
Rows(y).EntireRow.Delete
Else
y = y + 1
End If
Loop
End Sub
关于您原来的 VBA 的一些评论:
- “这是试图识别电子邮件中的@符号...”:
left(r.Text,2)
选择字符串的前两个字符,它永远不会等于一个字符长的字符串(“@”)!(我的代码根据[后的第一个字符决定位置) - “并分别将所有电子邮件地址向右移动两个位置” - 您的代码是
OFFSET(0,1)
,即右边只有一列,请始终检查代码的一致性。 - “一旦数据位于正确的列中,我需要自动移动到正确的行” - 我的代码在同一步骤中完成这两项操作,除了代码更短之外,它甚至更简单。