excel - 我需要创建循环以从 excel 复制以粘贴到记事本中
问题描述
我在两列 A(条形码)和 B(计数)中有数据。我需要一个宏,它从 A 列复制数据并将其多次粘贴到记事本中,如 B 列所述。下面是我的代码,仅适用于选定的行。请帮助创建一个循环,以便宏工作到包含数据的最后一行: 示例数据
Sub Receivinggg()
Dim obj As New DataObject
Dim bc As Variant
Dim i As Integer
Dim j As Integer
j = Cells(ActiveCell.Row, 2).Value
For i = 1 To j
bc = Selection.Value
If Len(bc) < 11 Then
bc = "0" & Selection.Value
End If
obj.SetText bc
obj.PutInClipboard
VBA.AppActivate ("1 - Notepad"), 0
SendKeys "+{INSERT}"
Application.Wait Now + TimeValue("00:00:02")
SendKeys "{Enter}"
Next i
VBA.AppActivate ("Receiving - Excel"), 0
SendKeys "{Down}"
End Sub
解决方案
问题已解决,我成功地在循环中添加了一个循环以获得所需的结果。无论如何谢谢。
Sub test()
Dim bc As Variant
Dim cellrow As Integer
Dim cellcol As Integer
Dim lastrow As Integer
Dim x As Integer
Dim i As Integer
Dim obj As New DataObject
Dim j As Integer
cellrow = 2
cellcol = 1
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow
Cells(cellrow, cellcol).Select
j = Cells(ActiveCell.Row, 2).Value
For x = 1 To j
bc = Selection.Value
If Len(bc) < 11 Then
bc = "0" & Selection.Value
End If
obj.SetText bc
obj.PutInClipboard
VBA.AppActivate ("1 - Notepad"), 0
' VBA.AppActivate ("aaaa - WebUtil"), 0
SendKeys "+{INSERT}"
Application.Wait Now + TimeValue("00:00:03")
SendKeys "{Enter}"
Next x
VBA.AppActivate ("Receiving - Excel"), 0
cellrow = cellrow + 1
Next i
End Sub
推荐阅读
- talend - Talend:匹配 2 个列并仅显示这些值匹配的行
- qt - 有没有办法在 qml 中以字符串格式获取其 id 的组件?
- angular - VSTS Build CI 给出错误安装角度 ##[error]Bash exited with code '243'
- android - SQLite 如何将列的所有字符串内容添加到单个字符串(带条件)
- php - 尝试导入文件
- android - Retrofit2:将 post 参数添加到拦截器中
- python - Flask 应用程序中的子资源完整性
- azure-active-directory - Azure AD B2C 序列化 cookie 中的 StringCollection 声明
- python - 以 minio 作为后端的 Django-Storages S3
- javascript - React 应用程序上的响应式布局