即时得到的对象变量或带块变量使用Excel VBA

Question

进出口试图从我WeeklyDiet片到我DietStats片复制范围从一个片复制范围时到另一未设置错误。

在细胞WeeklyDiet的A1我进入周数如下例如WK1，WK2等

我要粘贴数据在A1当周美国DietStats.Range（无论行B4：B55 ），其中包含相当于周数的数据，例如，如果Wk2在A1中，我希望将数据粘贴到DietStats工作表的范围（B4：B55）中的任何行中包含Wk2。

即时得到一个对象变量或With块变量未设置错误消息。

Sub SaveDietMacrosForWeek() 

        Dim Ws1 As Worksheet 
        Dim Ws2 As Worksheet 
        Dim NR As Long 

        Set Ws1 = ActiveWorkbook.Sheets("WeeklyDiet") 
        Set Ws2 = ActiveWorkbook.Sheets("DietStats") 

        Dim Week As String 
        Week = Ws1.Range("A1") 
        NR = Ws2.Range("B4:B55").Find(Week).Row 

         Ws1.Range("E75:I75").Copy 
         Ws2.Range("K" & NR).PasteSpecial (xlPasteValues) 

         Ws1.Range("L75:P75").Copy 
         Ws2.Range("R" & NR).PasteSpecial (xlPasteValues) 

         Ws1.Range("S75:W75").Copy 
         Ws2.Range("Y" & NR).PasteSpecial (xlPasteValues) 

         Ws1.Range("Z75:AD75").Copy 
         Ws2.Range("AF" & NR).PasteSpecial (xlPasteValues) 

         Ws1.Range("AG75:AK75").Copy 
         Ws2.Range("AM" & NR).PasteSpecial (xlPasteValues) 

         Ws1.Range("AN75:AR75").Copy 
         Ws2.Range("AT" & NR).PasteSpecial (xlPasteValues) 

         Ws1.Range("AU75:AY75").Copy 
         Ws2.Range("BA" & NR).PasteSpecial (xlPasteValues) 

        ActiveWorkbook.Save 

        End Sub 

Answer 1

使用Applicatiopn.Match整列B对获得的行号。通过将返回值传递给变体，您将获得真正的行号或错误值。

Sub SaveDietMacrosForWeek() 

    Dim Ws1 As Worksheet 
    Dim Ws2 As Worksheet 
    Dim NR As Variant 

    Set Ws1 = ActiveWorkbook.Sheets("WeeklyDiet") 
    Set Ws2 = ActiveWorkbook.Sheets("DietStats") 

    Dim Week As String 
    Week = Ws1.Range("A1") 

    NR = Application.Match(Week, Ws2.Range("B:B"), 0) 

    If Not IsError(NR) Then 

     Ws2.Range("K" & NR).Resize(1, 5) = Ws1.Range("E75:I75").Value 
     Ws2.Range("R" & NR).Resize(1, 5) = Ws1.Range("L75:P75").Value 
     Ws2.Range("Y" & NR).Resize(1, 5) = Ws1.Range("S75:W75").Value 
     Ws2.Range("AF" & NR).Resize(1, 5) = Ws1.Range("Z75:AD75").Value 
     Ws2.Range("AM" & NR).Resize(1, 5) = Ws1.Range("AG75:AK75").Value 
     Ws2.Range("AT" & NR).Resize(1, 5) = Ws1.Range("AN75:AR75").Value 
     Ws2.Range("BA" & NR).Resize(1, 5) = Ws1.Range("AU75:AY75").Value 

    End If 
    ActiveWorkbook.Save 

End Sub 

我已经使用直接值转移而不是复制，粘贴特殊值。直接价值转移更有效，但需要与来源大小相同的目标。

Answer 2

不知道周是什么，所以可能需要一些调整。

Sub SaveDietMacrosForWeek() 

Dim Ws1 As Worksheet 
Dim Ws2 As Worksheet 
Dim r As Range 
Dim NR As Long 
Dim Week As String 

Set Ws1 = ActiveWorkbook.Sheets("WeeklyDiet") 
Set Ws2 = ActiveWorkbook.Sheets("DietStats") 

Week = Ws1.Range("A1") 
Set r = Ws2.Range("B4:B55").Find(What:=Week, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 

If Not r Is Nothing Then 
    NR = r.Row 
    'rest of code 
End If 

End Sub