ws-Cells以验证If或选择单元格

Question

我正试图在网络上打开另一个文件，然后复制与原始Excel文件匹配的列。

Cells函数不允许我验证If，也不允许我选择单元格。

Sub pull_columns()
Dim head_count As Integer
Dim row_count As Integer
Dim col_count As Integer
Dim i As Integer
Dim j As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Tabelle1")
head_count = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlToRight)))
Workbooks.Open Filename:="C:Users...CC_Global_Log_File_Scenario_Split.xlsx"
ActiveWorkbook.Sheets(1).Activate
row_count = WorksheetFunction.CountA(Range("A3", Range("A3").End(xlDown)))
col_count = WorksheetFunction.CountA(Range("A3", Range("A3").End(xlToRight)))
For i = 1 To head_count
j = 1
Do While j <= col_count
If ws.Cells(2, i) = ActiveSheet.Cells(3, j).Text Then
ActiveSheet.Range(Cells(3, j), Cells(row_count, j)).Copy
ws.Cells(2, i).PasteSpecial xlPasteValues
Application.CutCopyMode = False
j = col_count
End If
j = j + 1
Loop
Next i
ActiveWorkbook.Close savechanges:=False
ws.Cells(2, 1).Select
Application.ScreenUpdating = True
End Sub

Answer 1

你的问题有点模棱两可，很难说出你有什么问题。然而，我可以看出你的一些推荐信是不合格的。我稍微重写了您的代码，并确保所有范围等现在都合格(即工作表在代码中说明，而不是隐含的(：

Option Explicit
Sub pull_columns()
Dim head_count As Integer
Dim row_count As Integer
Dim col_count As Integer
Dim i As Integer
Dim j As Integer
Dim ws As Worksheet
Dim sourcewkb As Workbook
Dim sourcesheet As Worksheet
Dim wkb As Workbook

Set wkb = ActiveWorkbook

Application.ScreenUpdating = False
Set ws = wkb.Sheets("Tabelle1")
head_count = WorksheetFunction.CountA(ws.Range("A2", ws.Range("A2").End(xlToRight)))

Set sourcewkb = Workbooks.Open("C:Users...CC_Global_Log_File_Scenario_Split.xlsx")
Set sourcesheet = sourcewkb.Worksheets("Automotive")

row_count = WorksheetFunction.CountA(sourcesheet.Range("A3", sourcesheet.Range("A3").End(xlDown)))
col_count = WorksheetFunction.CountA(sourcesheet.Range("A3", sourcesheet.Range("A3").End(xlToRight)))

For i = 1 To head_count
j = 1
Do While j <= col_count
If ws.Cells(2, i).Value = sourcesheet.Cells(3, j).Value Then
sourcesheet.Range(Cells(3, j), sourcesheet.Cells(row_count, j)).Copy
ws.Cells(2, i).PasteSpecial xlPasteValues
Application.CutCopyMode = False
j = col_count
End If
j = j + 1
Loop
Next i

sourcewkb.Close savechanges:=False
ws.Cells(2, 1).Select

Application.ScreenUpdating = True
End Sub

也许这能解决你的问题？如果没有别的，它会让你更容易阅读/理解，并可能帮助你进一步描述这个问题。