偏移和结束功能

发布于 2024-12-08 08:43:54 字数 912 浏览 0 评论 0原文

我正在尝试将数据从 Q3 表 1 粘贴到 Q3 表 2。每条数据应粘贴在 Q3 表 2 上最后一条数据下方的一行(从单元格 A4 开始)。不幸的是,该行

Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0) 

不这样做。相反,它将所有数据粘贴到 A4 中,并且它们继续相互覆盖,因此,当从 A4 一直到 A14 应该有多个条目时,A4 中只有一个条目。请帮忙。谢谢!

  With Worksheets("Q3 Sheet 1").Range("A3")
        'Count total number of entries
        nCustomers = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
        'Loop through all entries looking for amounts owed > 1000
        For iRow = 1 To nCustomers
            AmountOwed = .Offset(iRow, 1) - .Offset(iRow, 2)
            'If amount owed > 1000 then transfer customer ID and amount owing to Q3 Sheet 2
            If AmountOwed > 1000 Then
                Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

            End If
        Next iRow
    End With

I am trying to paste data from Q3 Sheet 1 to Q3 Sheet 2. Each piece of data should be pasted one row below the last piece of data on Q3 Sheet 2 (starting in cell A4). Unfortunately, the line

Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0) 

does not do this. Instead it pastes all the data in A4 and they continue to overwrite each other, so that there is only one entry in A4 when there should be multiple entries from A4 all the way up to A14. Please help. Thanks!

  With Worksheets("Q3 Sheet 1").Range("A3")
        'Count total number of entries
        nCustomers = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
        'Loop through all entries looking for amounts owed > 1000
        For iRow = 1 To nCustomers
            AmountOwed = .Offset(iRow, 1) - .Offset(iRow, 2)
            'If amount owed > 1000 then transfer customer ID and amount owing to Q3 Sheet 2
            If AmountOwed > 1000 Then
                Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

            End If
        Next iRow
    End With

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(4

捎一片雪花 2024-12-15 08:43:54

只需要两个小改动。

Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

应该读

Worksheets("Q3 Sheet 2").Range("A2").End(xlDown).Offset(1, 0) = .Offset(iRow, 0)

Only two small changes are needed.

Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

should read

Worksheets("Q3 Sheet 2").Range("A2").End(xlDown).Offset(1, 0) = .Offset(iRow, 0)
塔塔猫 2024-12-15 08:43:54

我重写了代码以使用范围(而不是使用范围来获取行然后循环行号),对变量进行标注并关闭屏幕更新(以提高速度),而且在查找时向上查找比向下查找更稳健最后记录

如果拥有的数量超过 1000,此版本会将整行从 Q3 表 1 复制到 Q3 表 2。它可以削减到您想要的任何数量的单元格(我认为您可能想要两个单元格? )

[更新:进一步整理代码,添加了 ws2 变量,删除了 AmountOwned 和冗余的 nCustomers]

   Sub Update()
   Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Application.ScreenUpdating = False
    Set ws = Worksheets("Q3 Sheet 1")
    Set ws2 = Worksheets("Q3 Sheet 2")
    Set rng1 = ws.Range(ws.[a4], ws.Cells(Rows.Count, "A").End(xlUp))
    For Each rng2 In rng1
        'If amount owed > 1000 then transfer customer ID and amount owing to Q3 Sheet 2
        If rng2.Offset(0, 1) - rng2.Offset(0, 2) > 1000 Then rng2.EntireRow.Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next
    Application.ScreenUpdating = True        
    End Sub

I've rewritten the code to work with ranges (rather than use a range to get rows then loop row numbers), dimension the variables and with screenupdating off (for speed), plus it is more robust to look up than down when finding the last record

This version copies the entire row from Q3 Sheet 1 to Q3 Sheet 2 if amount owned exceeds 1000. It can be cut back to whatever amount of cells your want (I think you may want two cells?)

[pdate: Tidied code further, added a ws2 variable, removed AmountOwned and redundant nCustomers]

   Sub Update()
   Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Application.ScreenUpdating = False
    Set ws = Worksheets("Q3 Sheet 1")
    Set ws2 = Worksheets("Q3 Sheet 2")
    Set rng1 = ws.Range(ws.[a4], ws.Cells(Rows.Count, "A").End(xlUp))
    For Each rng2 In rng1
        'If amount owed > 1000 then transfer customer ID and amount owing to Q3 Sheet 2
        If rng2.Offset(0, 1) - rng2.Offset(0, 2) > 1000 Then rng2.EntireRow.Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next
    Application.ScreenUpdating = True        
    End Sub
花想c 2024-12-15 08:43:54

将此行更改为

Worksheets("Q3 Sheet 2").Range("A3").End(xlDown).Offset(1, 0) = .Offset(iRow, 0) 

[] 的

Change this line to

Worksheets("Q3 Sheet 2").Range("A3").End(xlDown).Offset(1, 0) = .Offset(iRow, 0) 

[]'s

°如果伤别离去 2024-12-15 08:43:54
Worksheets("Q3 Sheet 2").cells(rows.count,1).End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

假设 A 列中工作表下方没有数据

Worksheets("Q3 Sheet 2").cells(rows.count,1).End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

Assuming there's no data lower down the sheet in column A

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文