Excel VBA：将表格中的单元格值复制到具有条件的不同工作表上的表格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/27260854/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA: Copy cell value in a table to a table on a different sheet with condition
提问by mHymanet
I'll apologize in advance for the large scope of this question and any vagueness I might create. I'd like to create a macro that goes down a table and copy a cell value if a particular condition is met in a different column in that row to a table in another sheet.
对于这个问题的范围很大以及我可能造成的任何含糊不清，我会提前道歉。我想创建一个宏，如果该行中的不同列中满足特定条件，则该宏会沿着表格向下移动并复制单元格值到另一张表格中的表格。
Basically, if Condition equals X in column C in Table A, then copy Number from column B in Table A to column B in Table B. There are 2k+ rows. Column C in Table A is always empty or equals X, and column B in Table A is never empty until the end of the list. Column B in Table B is blank and the number of rows will be determined by the number of rows copied to it from Table A.
基本上，如果条件等于表 A 中 C 列中的 X，则将 Number 从表 A 中的 B 列复制到表 B 中的 B 列。有 2k+ 行。表 A 中的 C 列始终为空或等于 X，而表 A 中的 B 列在列表末尾之前永远不会为空。表 B 中的 B 列是空白的，行数将由从表 A 复制到它的行数决定。
I'm sure this will require a loop, but being new to VBA, I'm not sure which loop type I need and how the loop logic should look. I suspect a Do Until would be easiest since there are no blanks in Table A until the end of the list. My best guess so far:
我确定这将需要一个循环，但我是 VBA 新手，我不确定我需要哪种循环类型以及循环逻辑应该如何。我怀疑直到列表结束时表 A 中都没有空白，因此最简单。到目前为止我最好的猜测：
Dim wsPAPS As Range
Dim wsPAVA As Range
Dim wsVNPN As Range
Dim wkATTR As Workbook
Set wkATTR = Workbooks("PARCEL_ATTR_MACRO-TEST.xlsm")
Set wsPAPS = Sheets("PARCEL_ATTR_BASE").Range("PARCELSTAT")
Set wsPAVA = Sheets("PARCEL_ATTR_BASE").Range("APO_VA_Properties_Vacant_Abandoned")
Set wsVNPN = Sheets("VA_NAME").Range("L1_PARCEL_NBR")
Do
If wsPAVA = "Vacant/Abandoned" Then
wsVNPN = wsPAPS
End IF
Loop Until wsPAPS = ""
Note this code doesn't actually work; I'm told I have a Loop without a Do, not sure why.
请注意，此代码实际上不起作用；有人告诉我我有一个没有 Do 的循环，不知道为什么。
I would be incredibly grateful for any help offered on this. Thanks, all!
如果对此提供任何帮助，我将不胜感激。谢谢大家！
UPDATEThe intent with the Range variables is to attempt to make referencing specific columns easy, but I get an application-defined or object-defined error for them.
更新Range 变量的目的是尝试使引用特定列变得容易，但我得到了应用程序定义或对象定义的错误。
回答by Manivannan KG
Please follow the below steps,
请按照以下步骤操作，
- Define the desitination worksheet/workbook by its range (cSheetName)
Define the source worksheet/workbook by its range(cFileLocWS)
Take row count for the operation to be performed can be upto 1 million rows.
Add the loop not necessarily do while a simple "For" would do.
- 按范围（cSheetName）定义目标工作表/工作簿
按范围定义源工作表/工作簿（cFileLocWS）
为要执行的操作取行数最多可达 100 万行。
添加循环不一定要做，而简单的“For”就可以了。
'Days Open for - Col:S
'开放日 - Col:S
'Existing Logic ==$T$1-I(n)+1
'$T$1 - end of month date
'现有逻辑==$T$1-I(n)+1
'$T$1 - 月末日期
lRowCount = Sheets(cSheetName).Cells(Rows.Count, "I").End(xlUp).Row
For rowIndex = 2 To lRowCount
mDate = Sheets(cFileLocWS).Range(cMonthEndDate).Value
strtDate = Sheets(cSheetName).Cells(rowIndex, "I").Value
lResult = (mDate - strtDate) + 1
Sheets(cSheetName).Cells(rowIndex, "S").Value = lResult
Next rowIndex
Hope this helps.
希望这可以帮助。
回答by SkyMaster
Try this:
尝试这个：
Assuming the sheet names are: "TableA" and "TableB" and Column B always has some data.
假设工作表名称是：“TableA”和“TableB”，B 列总是有一些数据。
Sub Copy()
Dim lr As Long, r As Long
Set Sh1 = ThisWorkbook.Worksheets("TableA")
Set Sh2 = ThisWorkbook.Worksheets("TableB")
lr = Sh1.Cells(Rows.Count, "B").End(xlUp).row
x = 2
For r = 2 To lr
If Range("C" & r).Value = "X" Then 'Evaluate the condition.
Sh2.Range("B" & x).Value = Sh1.Range("B" & r).Value 'ColumnB
x = x + 1
End If
Next r
Sh2.Select
End Sub
