对于每个范围，包括一个可变问题

时间：2018-08-31 13:21:28

标签： vba excel-vba

我的一小段代码有问题：我希望它选择从c开始的单元格，该单元格满足我之前定义的条件，一直到列表的末尾。在此范围内，我希望它复制超过resultat的第一个值（之前获得的值）。 

With Worksheets("Feuil1").Range("A2:A5181")
 Set c = .Find(Worksheets("Feuil2").Range("A14").Value, LookIn:=xlValues)
  If Not c Is Nothing Then
    firstAddress = c.Address
    Do
 Range(Range(c), Range(c).End(xlDown)).Select
  If c Is Nothing Then
        GoTo DoneFinding
    End If
    Loop While c.Address <> firstAddress
  End If
DoneFinding:
End With

Dim c As Range
Dim firstAddress As String
Dim resultat As Double
Dim Cel As Range
Dim firstValue As Integer
Dim s1 As String, s2 As String

s1 = Worksheets("Feuil2").Range(c)
s2 = Worksheets("Feuil1").Range(s1).End(xlDown)
Worksheets("Feuil1").Range(s1 & ":" & s2).Select


For Each Cel In Range(s1 & ":" & s2)
    If Cel.Value >= resultat Then
        firstValue = Cel.Value
        firstAddress = Cel.Address
        Exit For
    End If
Next

Worksheets("Feuil1").firstValue.Copy
Range("C14").Worksheet("Feuil2").PasteSpecial

代码的前2行出现错误。

非常感谢您的帮助。

这是我的新代码，因为我意识到缺少某些内容。SearchRange不是从第2行开始，而是从值（日期）等于最后一个日期的行开始ws2。我的For each line出现错误。它说需要对象。

编辑-新代码，在rangyrange处出现对象错误： 

Private Sub CommandButton1_Click()

Dim rangyrange As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim foundRange As Range
Dim searchRange As Range
Dim lastRow As Long
Dim ws1Cell As Range
Dim firstAddress As String
Dim Cel As Range
Dim firstValue As Double
Dim A15Value As Date
Dim firsty As Long
Dim newRange As Range
Dim lastRow2 As Long

Set ws1 = Excel.Application.ThisWorkbook.Worksheets("Feuil1")
Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Feuil2")


A15Value = CDate(ws2.Cells(15, 1).Value)

With ws1

 lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
 lastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row

  Set foundRange = ws1.Range(.Cells(2, 1), .Cells(lastRow, 1))
  Set searchRange = foundRange.Find(A15Value, LookIn:=xlValues)
  Set rangyrange = ws1.Range(.Cells(searchRange.Row, 1), .Cells(lastRow, 1))
  firsty = rangyrange.Rows(1).Row

  Set newRange = ws1.Range(.Cells(firsty, 2), .Cells(lastRow2, 2))

End With

 For Each ws1Cell In newRange
   If ws1Cell.Value >= resultat Then

     firstValue = ws1Cell.Value

   firstAddress = ws1Cell.Address
Exit For
   End If
Next


ws2.Cells(15, 3).Value = firstValue
End Sub

1 个答案:

答案 0 :(得分：0)

Dim c As Range

Worksheets("Feuil1").Range(Worksheets("Feuil1").Range(c), Worksheets("Feuil1").Range(c).End(xlDown))

您尚未将c设置为一个范围，因此VBA无法理解您的操作。

此外，我建议定义一个工作表变量以提高代码的可读性，例如：

Set ws = Excel.Application.Worksheets("Feuil1")

您的陈述变得更加清晰：

ws.Range(ws.Range(c), ws.Range(c).End(xlDown))

这也不是您引用范围的方式，我建议不要使用.Select。

Range(s1 & ":" & s2).Select

这是您引用范围的方式：

'this is my preferred method of referencing a range
Set someVariable = ws.Range(ws.Cells(row, column), ws.Cells(row, column))

或者... 

'this is useful in some instances, but this basically selects a cell
Set someVariable = ws.Range("B2")

或者... 

'this references the range A1 to B1
Set someVariable = ws.Range("A1:B1")

而且，正如@BigBen指出的那样，您不能像这样设置范围：

Dim c As Range
s1 = Worksheets("Feuil2").Range(c)

原因是：

  1. c尚未分配。
  2. 除非范围的形式为ws.Range(ws.Cells(row, column), ws.Cells(row, column))
    3. ，否则您不能使用范围作为输入

根据您的更新，其中包括c的分配：

  

代码的前2行出现错误。

这是因为您在声明c之前先分配了c。

您应该将所有Dim语句放在实际代码之前（除非您知道自己在做什么），像这样：

Public Sub MySub()
    Dim c As Range
    Dim firstAddress As String
    Dim resultat As Double
    Dim Cel As Range
    Dim firstValue As Integer
    Dim s1 As String, s2 As String

    `the rest of your code
End Sub

我会将您的Do循环更改为以下内容：

With Worksheets("Feuil1").Range("A2:A5181")
    Set c = .Find(Worksheets("Feuil2").Range("A14").Value, LookIn:=xlValues)
    If Not c Is Nothing Then
    firstAddress = c.Address
        Do While c.Address <> firstAddress
            'I'm unsure of the goal here, so I'm ignoring it
            Range(Range(c), Range(c).End(xlDown)).Select
            If c Is Nothing Then
                Exit Do
            End If
        Loop
    End If
End With

主要是因为我讨厌GoTo语句，并且因为Do的{​​{3}}循环状态使用Do While或Do Until而不是Loop While或{{1 }}

Loop Until和s1是字符串，所以您不能这样做：

s2

我假设您要获取s1 = Worksheets("Feuil2").Range(c) s2 = Worksheets("Feuil1").Range(s1).End(xlDown) 的列和行并对其进行迭代，但是问题是您正在使用2个c工作表，但是您无法这样做。我假设这是一个错误，并且您要在“ Fueil2”工作表上工作，所以去了：

different

午餐后编辑：

MS doc似乎有点误导，因为我测试了此代码段，并且可以正常工作：

Dim ws2 As Worksheet
Dim startCell As Range
Dim endCell As Range
Dim foundRange As Range

Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Fueil2")
With ws2
    Set startCell = .Cells(c.Row, c.Column)
    Set endCell = .Cells(c.End(xlUp).Row, c.Column)
    Set foundRange = .Range(.Cells(c.Row, c.Column), .Cells(c.End(xlUp).Row, c.Column))

    For Each Cel In foundRange
        'yada yada yada
End With

新编辑： 

Public Sub test()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim foundRange As Range
    Dim searchRange As Range
    Dim workRange As Range
    Dim foundColumn As Range
    Dim ws1LastCell As Range
    Dim ws1Range As Range
    Dim iWantThis As Range

    Set ws1 = Excel.Application.ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Sheet2")
    Set searchRange = ws1.Range("A1:F1")
    Set foundRange = searchRange.Find(ws2.Range("C1").Value, LookIn:=xlValues)

    With foundRange
        'last cell in the ws1 column that's the same column as foundRange
        Set ws1LastCell = ws1.Range(ws1.Cells(.Row, .Column), ws1.Cells(ws1.Rows.Count, .Column)).End(xlDown)
        'the range you want
        Set iWantThis = ws1.Range(foundRange, ws1LastCell)
        'check to see if it got what i wanted on ws1
        iWantThis.Select
    End With
End Sub

直到我看到Public Sub test() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim c14Value As Double Dim searchRange As Range Dim lastRow As Long Dim ws1Cell As Range Set ws1 = Excel.Application.ThisWorkbook.Worksheets("Sheet1") Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Sheet2") 'gets the date A14Value = CDate(ws2.Cells(14, 1).Value) With ws1 'gets the last row's number in column A on worksheet 1 lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'selects from A2 to the last row with data in it. this works only if 'there aren't any empty rows between your data, and that's what i'm assuming. Set searchRange = .Range(.Cells(2, 1), .Cells(lastRow, 1)) End With For Each ws1Cell In searchRange If CDate(ws1Cell.Value) >= A14Value Then 'i didnt make a variable for firstValue firstValue = ws1Cell.Value 'i didnt make a variable for firstAddress firstAddress = ws1Cell.Address Exit For End If Next 'puts firstValue into cell C14 on ws2 ws2.Cells(14, 3).Value = firstValue End Sub 的定义，我假设它是100％正确声明和分配的。提示：您应该给我们resultat的声明和赋值，因为我无法完全确定您对resultat的定义是否有问题。

相关问题
最新问题