Question

这让我疯了，我已经在这里待了两个星期而且我无处可去，这只是相当复杂（对我来说）项目的第一部分。我有1张工作簿，有3张（可用性）（分配）（最终）。我收集人们的可用性然后我希望执行一系列任务。列（a）有一个人名列表（这不是固定的，可以扩展和收缩）其他列的标题是日期（这不是固定的，可以扩展和收缩）。首先，我需要搜索所有列（在可用性中）并找到（x1）的实例记录人员的姓名和找到（x1）的单元格的地址。我已经完成并使用（立即）我可以看到正在找到名称和单元格位置。下一位是打开分配表找到人名，然后把（x1）放在它找到的相同单元格地址中。我已经添加了代码来激活（分配）工作表并设置我想要的范围搜索要开始的名称，但是当我运行代码时，它会进入＆＃34;工作表（＆＃34;分配＆＃34;）。激活＆＃34;并给出错误＆＃34;应用程序定义或对象定义的错误＆＃34;。我不知道为什么。您将从代码中看到我是VBA的真正初学者，因为我确信有一种更有效的方式来编写此代码，但这是我在经过2周的努力搜索之后想出来的。如果您能够提供帮助或建议任何改进，我可以请您评论任何代码，以便我知道它在做什么，否则我将永远无法弄清楚发生了什么并学习任何东西。

Private Sub CommandButton1_Click()

'Dim namerange As Range
'Dim namecell As Range
'Dim firstcell As String
'Dim singlecell As Range
Dim listofcellsb As Range
Dim listofcellsc As Range
Dim listofcellsd As Range
Dim listofcellse As Range
Dim listofcellsf As Range
Dim listofcellsg As Range
Dim listofcellsh As Range
Dim listofcellsi As Range
Dim listofcellsj As Range
Dim listofcellsk As Range
Dim listofcellsl As Range
Dim listofcellsm As Range
Dim listofcellsn As Range
Dim listofcellso As Range
Dim listofcellsp As Range
Dim listofcellsq As Range
Dim listofcellsr As Range
Dim listofcellss As Range
Dim listofcellst As Range
Dim listofcellsu As Range
Dim listofcellsv As Range
Dim listofcellsw As Range
Dim listofcellsx As Range
Dim listofcellsy As Range
Dim listofcellsz As Range
Dim addresscell As String
Dim namecell As String




Set listofcellsb = Range("b4", Range("b3").End(xlDown))

Worksheets("allocation").Activate
Range("a3").Select

    For Each singlecellb In listofcellsb
        If singlecellb.Value = "x1" Then
            Debug.Print singlecellb.Offset(0, 0).Address
            ActiveCell.Value = singlecellb.Offset(0, -1).Value
        End If
    Next singlecellb
Worksheets("availability").Activate

Set listofcellsc = Range("c4", Range("c3").End(xlDown))
    For Each singlecellc In listofcellsc
        If singlecellc.Value = "x1" Then
            Debug.Print singlecellc.Offset(0, 0).Address
            Debug.Print singlecellc.Offset(0, -2).Value
        End If
    Next singlecellc

Set listofcellsd = Range("d4", Range("d3").End(xlDown))
    For Each singlecelld In listofcellsd
        If singlecelld.Value = "x1" Then
            Debug.Print singlecelld.Offset(0, 0).Address
            Debug.Print singlecelld.Offset(0, -3).Value
        End If
    Next singlecelld

Set listofcellse = Range("e4", Range("e3").End(xlDown))
    For Each singlecelle In listofcellse
        If singlecelle.Value = "x1" Then
            Debug.Print singlecelle.Offset(0, 0).Address
            Debug.Print singlecelle.Offset(0, -4).Value
        End If
    Next singlecelle

Set listofcellsf = Range("f4", Range("f3").End(xlDown))
    For Each singlecellf In listofcellsf
        If singlecellf.Value = "x1" Then
            Debug.Print singlecellf.Offset(0, 0).Address
            Debug.Print singlecellf.Offset(0, -5).Value
        End If
    Next singlecellf

Set listofcellsg = Range("g4", Range("g3").End(xlDown))
    For Each singlecellg In listofcellsg
        If singlecellg.Value = "x1" Then
            Debug.Print singlecellg.Offset(0, 0).Address
            Debug.Print singlecellg.Offset(0, -6).Value
        End If
    Next singlecellg

Set listofcellsh = Range("h4", Range("h3").End(xlDown))
    For Each singlecellh In listofcellsh
        If singlecellh.Value = "x1" Then
            Debug.Print singlecellh.Offset(0, 0).Address
            Debug.Print singlecellh.Offset(0, -7).Value
        End If
    Next singlecellh

Set listofcellsi = Range("i4", Range("i3").End(xlDown))
    For Each singlecelli In listofcellsi
        If singlecelli.Value = "x1" Then
            Debug.Print singlecelli.Offset(0, 0).Address
            Debug.Print singlecelli.Offset(0, -8).Value
        End If
    Next singlecelli

Set listofcellsj = Range("j4", Range("j3").End(xlDown))
    For Each singlecellj In listofcellsj
        If singlecellj.Value = "x1" Then
            Debug.Print singlecellj.Offset(0, 0).Address
            Debug.Print singlecellj.Offset(0, -9).Value
        End If
    Next singlecellj

Set listofcellsk = Range("k4", Range("k3").End(xlDown))
    For Each singlecellk In listofcellsk
        If singlecellk.Value = "x1" Then
            Debug.Print singlecellk.Offset(0, 0).Address
            Debug.Print singlecellk.Offset(0, -10).Value
        End If
    Next singlecellk

Set listofcellsl = Range("l4", Range("l3").End(xlDown))
    For Each singlecelll In listofcellsl
        If singlecelll.Value = "x1" Then
            Debug.Print singlecelll.Offset(0, 0).Address
            Debug.Print singlecelll.Offset(0, -11).Value
        End If
    Next singlecelll

Set listofcellsm = Range("m4", Range("m3").End(xlDown))
    For Each singlecellm In listofcellsm
        If singlecellm.Value = "x1" Then
            Debug.Print singlecellm.Offset(0, 0).Address
            Debug.Print singlecellm.Offset(0, -12).Value
        End If
    Next singlecellm

Set listofcellsn = Range("n4", Range("n3").End(xlDown))
    For Each singlecelln In listofcellsn
        If singlecelln.Value = "x1" Then
            Debug.Print singlecelln.Offset(0, 0).Address
            Debug.Print singlecelln.Offset(0, -13).Value
        End If
    Next singlecelln

Set listofcellso = Range("o4", Range("o3").End(xlDown))
    For Each singlecello In listofcellso
        If singlecello.Value = "x1" Then
            Debug.Print singlecello.Offset(0, 0).Address
            Debug.Print singlecello.Offset(0, -14).Value
        End If
    Next singlecello

Set listofcellsp = Range("p4", Range("p3").End(xlDown))
    For Each singlecellp In listofcellsp
        If singlecellp.Value = "x1" Then
            Debug.Print singlecellp.Offset(0, 0).Address
            Debug.Print singlecellp.Offset(0, -15).Value
        End If
    Next singlecellp

Set listofcellsq = Range("q4", Range("q3").End(xlDown))
    For Each singlecellq In listofcellsq
        If singlecellq.Value = "x1" Then
            Debug.Print singlecellq.Offset(0, 0).Address
            Debug.Print singlecellq.Offset(0, -16).Value
        End If
    Next singlecellq

Set listofcellsr = Range("r4", Range("r3").End(xlDown))
    For Each singlecellr In listofcellsr
        If singlecellr.Value = "x1" Then
            Debug.Print singlecellr.Offset(0, 0).Address
            Debug.Print singlecellr.Offset(0, -17).Value
        End If
    Next singlecellr

Set listofcellss = Range("s4", Range("s3").End(xlDown))
    For Each singlecells In listofcellss
        If singlecells.Value = "x1" Then
            Debug.Print singlecells.Offset(0, 0).Address
            Debug.Print singlecells.Offset(0, -18).Value
        End If
    Next singlecells

Set listofcellst = Range("t4", Range("t3").End(xlDown))
    For Each singlecellt In listofcellst
        If singlecellt.Value = "x1" Then
            Debug.Print singlecellt.Offset(0, 0).Address
            Debug.Print singlecellt.Offset(0, -19).Value
        End If
    Next singlecellt

Set listofcellsu = Range("u4", Range("u3").End(xlDown))
    For Each singlecellu In listofcellsu
        If singlecellu.Value = "x1" Then
            Debug.Print singlecellu.Offset(0, 0).Address
            Debug.Print singlecellu.Offset(0, -20).Value
        End If
    Next singlecellu

Set listofcellsv = Range("v4", Range("v3").End(xlDown))
    For Each singlecellv In listofcellsv
        If singlecellv.Value = "x1" Then
            Debug.Print singlecellv.Offset(0, 0).Address
            Debug.Print singlecellv.Offset(0, -21).Value
        End If
    Next singlecellv

Set listofcellsw = Range("w4", Range("w3").End(xlDown))
    For Each singlecellw In listofcellsw
        If singlecellw.Value = "x1" Then
            Debug.Print singlecellw.Offset(0, 0).Address
            Debug.Print singlecellw.Offset(0, -22).Value
        End If
    Next singlecellw

Set listofcellsx = Range("x4", Range("x3").End(xlDown))
    For Each singlecellx In listofcellsx
        If singlecellx.Value = "x1" Then
            Debug.Print singlecellx.Offset(0, 0).Address
            Debug.Print singlecellx.Offset(0, -23).Value
        End If
    Next singlecellx

Set listofcellsy = Range("y4", Range("y3").End(xlDown))
    For Each singlecelly In listofcellsy
        If singlecelly.Value = "x1" Then
            Debug.Print singlecelly.Offset(0, 0).Address
            Debug.Print singlecelly.Offset(0, -24).Value
        End If
    Next singlecelly

Set listofcellsz = Range("z4", Range("z3").End(xlDown))
    For Each singlecellz In listofcellsz
        If singlecellz.Value = "x1" Then
            Debug.Print singlecellz.Offset(0, 0).Address
            Debug.Print singlecellz.Offset(0, -25).Value
        End If
    Next singlecellz

'Worksheets("allocation").Activate


End Sub

Answer 1

您可以尝试添加ThisWorkbook。在作为KeenLearner提到的工作表之前，或者您可以直接使用对象名称（我猜它是excel语言版本）

Sub test()

List1.Activate
Range("a3").Select

End Sub

Answer 2

如果我对你的理解正确，那么你可能正在寻找类似的东西。

这将循环显示可用性表中的第2列到第26列，并将任何X1复制到分配表中的相应列中（在具有相同名称的行中）

通过右键单击VBA编辑器的项目窗口并选择“插入...模块”来创建新模块。然后粘贴以下代码 - 然后，您需要在命令按钮的单击事件中调用此子。

Public Sub copyX1s()
Dim listofcells As Range
Dim currentname As String
Dim foundRow As Integer
Dim foundColumn As Integer
Dim i as integer

For i = 2 To 26

    Sheets("Availability").Activate
    Sheets("Availability").Range("A2").Select
    If Not Sheets("Availability").Cells(2, i) = "" Then
        Sheets("Availability").Range(Cells(2, i), Cells(2, i).End(xlDown)).Select
    Else
        GoTo skip:  'If the column has no data then skip to next column
    End If
    Set listofcells = Selection

    Sheets("Allocation").Activate
    Sheets("Allocation").Range("A2").Select

    For Each singleCell In listofcells
        If singleCell = "X1" Then
            foundColumn = singlecell.Column
            currentName = Sheets("Availability").Range("A" & singleCell.Row)
            Set foundName = Sheets("Allocation").Range("A:A").Find(What:=currentName, LookIn:=xlValues)
            foundRow = foundName.Row
            Sheets("Allocation").Cells(foundRow, foundColumn) = "X1"
        End If
    Next singleCell
skip:
Next i

End Sub

最后的每个循环得到列号，其中＆＃34; X1＆＃34;找到了，人员在A栏中命名。然后在＆＃34; Allocation＆＃34;中找到具有该人姓名的行。（如果名称是不同的顺序）。然后把它放在＆＃34; X1＆＃34;进入＆＃34;分配＆＃34;中的相应单元格片材。

vba在一个工作表中查找内容并将值复制到另一个工作表中的相同位置

2 个答案: