vba 根据另一列中的值选择一列中的一组单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/443081/
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
Select a set of cells in one column based on value in another
提问by
I have a big set of data in excel of the following form
我有以下表格的大量数据
A B
1 stuff1
6 stuff2
3 stuff3
1 stuff4
1 stuff5
7 stuff6
3 stuff7
2 stuff8
. .
. .
. .
5 stuffn
and what i would like is some vba code that will select all the cells in B that have a "1" in column A - I will be using this set to do some tasks in another part of my code
我想要的是一些 vba 代码，它将选择 B 中在 A 列中具有“1”的所有单元格 - 我将使用此集在我的代码的另一部分执行一些任务
any ideas?
有任何想法吗？
Thanks
谢谢
采纳答案by Jon Fournier
This should work:
这应该有效：
Sub SelectCellsInColBBasedOnColA()
Dim TheSheet As Worksheet
If TypeOf ActiveSheet Is Worksheet Then
Set TheSheet = ActiveSheet
Else
Exit Sub
End If
Dim Row As Integer
Dim CellsToSelect As String
For Row = 1 To TheSheet.Range("A" & CStr(TheSheet.Rows.Count)).End(xlUp).Row
If TheSheet.Range("A" & CStr(Row)).Value = 1 Then
If CellsToSelect <> "" Then CellsToSelect = CellsToSelect & ","
CellsToSelect = CellsToSelect & "B" & CStr(Row)
End If
Next Row
TheSheet.Range(CellsToSelect).Select
End Sub
回答by CheeseConQueso
i dont know exactly what you are trying to do in the longrun, but for this step, you could do this in column C =if(a1=1,b1,"")
and then apply a filter on column c and pick the option non blank
then you can just select the whole column c
我不知道从长远来看您要做什么，但是对于这一步，您可以在 C 列中执行此操作=if(a1=1,b1,"")
，然后在 c 列上应用过滤器并选择非空白选项，
然后您可以选择整个 c 列
回答by Fionnuala
There is always ADO.
总是有 ADO。
'Reference: Microsost ActiveX n.n Object Library '
'but it is not necessary, Dim rs and cn as object '
'if you do not wish to use a reference '
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
'From: http://support.microsoft.com/kb/246335 '
strFile = Workbooks(1).FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
'Substitute a name range for [Sheet1$] '
'or include a range of cells : [Sheet1&A1:C7] '
'F1 is field 1, because we have no header (HDR: No) '
strSQL = "SELECT * FROM [Sheet3$] " _
& "WHERE F1=1"
rs.Open strSQL, cn
'Write out to another sheet '
Worksheets(2).Cells(2, 1).CopyFromRecordset rs
