根据另一列中的值在一列中选择一组单元格

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

3 个解决方案

#1

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

#2

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

我不确切地知道你在longrun中想要做什么,但是对于这一步,你可以在C = if(a1 = 1,b1,“”)列中执行此操作,然后在列c上应用过滤器并选择选项非空白然后你可以选择整个列c

#3

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

#1