如何告诉Excel宏在当前工作表上的行数不足时开始一个新工作表?

huangapple go评论105阅读模式
英文:

How do you tell an Excel macro to start a new sheet if there are insufficient rows left on the current sheet?

问题

我有一个Excel工作簿。

它连接了一个与API相关的Power Query,每分钟刷新一次数据。

然后我有另一个静态的工作表,其中有一个宏,将动态工作表中的数据复制到静态工作表的第一个可用行,并设置为每1.5分钟运行一次。

我的问题是如何编辑这个代码,以便在工作表已满时开始一个新工作表并继续操作。或者,如果有更好的替代方法,请随时提出建议!

宏的代码如下:

Public interval As Double
Sub CopyLive_toStatic()
    '
    ' CopyLive_toStatic Macro
    ' 从动态查询复制数据到静态表
    
    Sheets("_api_key-xyz").Select
    Range("A2:O2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A1").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Call macro_timer
End Sub

Sub macro_timer()
    
    '告诉Excel下一次运行宏的时间。
    Application.OnTime Now + TimeValue("00:01:30"), "CopyLive_toStatic"
    
End Sub

目前我陷入困境,我已经尝试过谷歌搜索但没有成功。希望有更多VBA或类似问题经验的人可以帮忙解决!

英文:

I have an Excel workbook.

It has a powerquery connected to an API which refreshes with new data every minute.

I then have another sheet that is static, with a macro that copies the data from the dynamic sheet to the first available row on the static sheet, and is set to run at 1.5 minute intervals.

My question is how I could edit this code to realize that the sheet is full, to start a new sheet and continue the operation. Alternatively, please feel free to call me out on using excel to do this, any better alternatives welcome!

The code for the macro is below:

Public interval As Double
Sub CopyLive_toStatic()
'
' CopyLive_toStatic Macro
' Copy Data from Live Query to Static Table

Sheets("_api_key-xyz").Select
Range("A2:O2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Call macro_timer
End Sub

Sub macro_timer()

'Tells Excel when to next run the macro.
Application.OnTime Now + TimeValue("00:01:30"), "CopyLive_toStatic"

End Sub

At the moment i am stuck, I have tried google to no avail. Hoping someone with more experience in VBA or similar problems may come to the rescue!

答案1

得分: 1

我会尝试计算要粘贴的行数并将其放置在左边(假设在要复制的单批次中,行数不会超过1048576)。

Public interval As Double
Sub CopyLive_toStatic()
    '
    ' CopyLive_toStatic宏
    ' 从Live查询复制数据到静态表格

    Dim lastRow As Integer
    Dim rowsLeft As Integer

    ' 检查剩余空间和要复制的行数
    Sheets("_api_key-xyz").Select
    lastRow = Sheets("_api_key-xyz").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    rowsLeft = Sheets("Sheet" & ActiveWorkbook.Worksheets.Count).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    rowsLeft = 1048576 - rowsLeft

    ' 复制单元格
    Range("A2:O2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy

    ' 检查是否有足够的空间,如有必要则添加新工作表
    If lastRow < rowsLeft Then
        ThisWorkbook.Worksheets.Add.Name
        ActiveWorksheet.Name = ThisWorkbook.Worksheets.Count
    End If

    ' 粘贴数据
    Sheets("Sheet" & ActiveWorkbook.Worksheets.Count).Select
    Range("A1").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Call macro_timer
End Sub

Sub macro_timer()

    ' 告诉Excel何时下次运行宏。
    Application.OnTime Now + TimeValue("00:01:30"), "CopyLive_toStatic"

End Sub

然而,我担心如果查询中的行数超过最大限制,这将无法工作 - 它每次都会上传所有搜索结果,因此您还必须添加一些代码来编辑查询以排除已复制的行,但您需要粘贴查询详细信息以获得帮助。

英文:

I would try counting rows to be pasted and place left (it should do the trick assuming, that in single batch to be copied there will be no more rows than 1048576).

Public interval As Double
Sub CopyLive_toStatic()
&#39;
&#39; CopyLive_toStatic Macro
&#39; Copy Data from Live Query to Static Table

    Dim lastRow As Integer
    Dim rowsLeft As Integer

&#39;   Check space left &amp; rows to be copied
    Sheets(&quot;_api_key-xyz&quot;).Select
    lastRow = Sheets(&quot;_api_key-xyz&quot;).Cells.Find(&quot;*&quot;, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    rowsLeft = Sheets(&quot;Sheet&quot; &amp; ActiveWorkbook.Worksheets.Count).Cells.Find(&quot;*&quot;, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    rowsLeft = 1048576 - rowsLeft
    
&#39;   Copy cells
    Range(&quot;A2:O2&quot;).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    
&#39;   Check if enough space &amp; add new worksheet if needed
    If lastRow &lt; rowsLeft Then
        ThisWorkbook.worksheets.Add.Name
        activeworksheet.Name = ThisWorkbook.Worksheets.Count
    End If

&#39;   Paste data
    Sheets(&quot;Sheet&quot; &amp; ActiveWorkbook.Worksheets.Count).Select
    Range(&quot;A1&quot;).End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Call macro_timer
End Sub

Sub macro_timer()

&#39;Tells Excel when to next run the macro.
Application.OnTime Now + TimeValue(&quot;00:01:30&quot;), &quot;CopyLive_toStatic&quot;

End Sub

Nevertheless, I would be concerned that this will not work, if there will be more than maximum rows in query - it uploads all search result each time, so you have to also add few lines editing the query to exclude already copied rows, but you would have to paste query details to get help with this.

答案2

得分: 0

您更清楚,但我必须指出,如果API每分钟刷新一次新数据,而您每分钟半运行一次例程,那么您肯定会丢失一些数据。

如果要在超出行数限制时创建新工作表,我建议以下操作:

您将创建一个具有值的工作簿范围命名范围:您要复制到的原始工作表的名称,例如="Sheet1"。在我的示例中,我将其命名为"CURRENTSHEET",您可以在附加的图像中看到。现在,每次执行CopyLive_toStatic时,它都会从"CURRENTSHEET"读取工作表的名称,并检查要添加的记录是否超过限制。如果没有,我们进行复制,如果是,则创建一个新工作表,将其名称保存到"CURRENTSHEET",然后继续复制。

在代码中,我避免了选择和选择,并且直接复制而不是粘贴。确定工作表已满时的限制由以下语句中的值定义:

Const MAX_ALLOWED_ROWS = 500000

每个记录块将要么复制到当前工作表,要么如果不适合,则完全复制到新工作表。

英文:

如何告诉Excel宏在当前工作表上的行数不足时开始一个新工作表?
You would know better but I must note that if the API refreshes with new data every minute and you run the routine every minute and a half, you are bound to lose some of the data in between.
To create a new sheet if a line limit is exceeded, I suggest the following:
You will create a Book scope Named range with value: the name of the original sheet you are copying to, eg ="Sheet1". In my example I call this Name: "CURRENTSHEET", as you will see in the attached image. Now every time CopyLive_toStatic is executed it will read the name of the sheet from "CURRENTSHEET" and check if the records to be added will exceed the limit, if not, we do the copy, if yes then we create a new sheet, save its name to "CURRENTSHEET" and proceed to copy.
In the code I avoid Selection and Select and instead of Paste I copy directly. The limit that determines when a sheet is full is defined by changing the value in the statement
Const MAX_ALLOWED_ROWS = 500000.
Each block of records will either be copied to the current sheet, or if it does not fit, it will be copied entirely to the new sheet.

Option Explicit

Public Sub CopyLive_toStatic()
   &#39;
   &#39; CopyLive_toStatic Macro
   &#39; Copy Data from Live Query to Static Table
   Dim destWs As Worksheet, curDestSheetName As String, srcRng As Range, destCell As Range, rngToCopy As Range
   Const MAX_ALLOWED_ROWS = 1010000, QUOT = &quot;&quot;&quot;&quot;
   
   Set srcRng = Worksheets(&quot;_api_key-xyz&quot;).Range(&quot;A2:O2&quot;)
   Application.CutCopyMode = False
   Set rngToCopy = Worksheets(&quot;items&quot;).Range(srcRng, srcRng.End(xlDown))
   curDestSheetName = Application.Evaluate(ThisWorkbook.Names(&quot;CURRENTSHEET&quot;).value)
   Set destWs = Worksheets(curDestSheetName)
   Set destCell = destWs.Cells(destWs.rows.CountLarge, &quot;A&quot;).End(xlUp).Offset(1, 0)
   If destCell.row + rngToCopy.rows.CountLarge &gt; MAX_ALLOWED_ROWS Then
      Set destWs = ThisWorkbook.Worksheets.Add(, destWs)
      Set destCell = destWs.Range(&quot;A1&quot;)
      curDestSheetName = destWs.Name
      ThisWorkbook.Names(&quot;CURRENTSHEET&quot;).value = &quot;=&quot; &amp; QUOT &amp; destWs.Name &amp; QUOT
   End If
   rngToCopy.Copy (Worksheets(curDestSheetName).Range(destCell.Address))
   Call macro_timer
End Sub

Sub macro_timer()
   &#39; Tells Excel when to next run the macro.
   Application.OnTime Now + TimeValue(&quot;00:01:30&quot;), &quot;CopyLive_toStatic&quot;
End Sub

答案3

得分: 0

在这个修改中,添加了以下内容:

  • 如果只有一行要复制
  • 完整表格问题(请参阅注释)
  • 连续生成新工作表

试一试

Sub CopyLive_toStatic()
'
' 复制Live查询数据到静态表格的宏

' Sheets("api_key-xyz").Select
Range("A2:O2").Select
If IsEmpty(Range("A3")) Then
Else
    Range(Selection, Selection.End(xlDown)).Select
End If
copyrows = Selection.Rows.Count
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Select
actcell = Selection(1).Address
actrow = Range(actcell).Row
If actrow + copyrows > Rows.Count Then
Set newsh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
newsh.Range("A1").PasteSpecial
newsh.Range("1:" & Rows.Count - actrow).Copy Destination:=Sheets("Sheet1").Range(actcell).Offset(1)
newsh.Range("1:" & Rows.Count - actrow).Delete
ttime = Time
ttime = WorksheetFunction.Replace(ttime, InStr(1, ttime, ":"), 1, "")
ttime = WorksheetFunction.Replace(ttime, InStr(1, ttime, ":"), 1, "")
Sheets("Sheet1").Name = "Sheet1_" & ttime
newsh.Name = "Sheet1"
Else
ActiveCell.Offset(1).PasteSpecial
End If

Call macro_timer
End Sub
英文:

In this modification the followings are added

  • If only one row to copy
  • Full table issue (see comment)
  • Continuous new sheet generation

Try it

Sub CopyLive_toStatic()
&#39;
&#39; CopyLive_toStatic Macro
&#39; Copy Data from Live Query to Static Table

&#39;Sheets(&quot;_api_key-xyz&quot;).Select
Range(&quot;A2:O2&quot;).Select
If IsEmpty(Range(&quot;A3&quot;)) Then
Else
    Range(Selection, Selection.End(xlDown)).Select
End If
copyrows = Selection.Rows.Count
Application.CutCopyMode = False
Selection.Copy
Sheets(&quot;Sheet1&quot;).Select
Range(&quot;A1&quot;).End(xlDown).Select
actcell = Selection(1).Address
actrow = Range(actcell).Row
If actrow + copyrows &gt; Rows.Count Then
Set newsh = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
newsh.Range(&quot;A1&quot;).PasteSpecial
newsh.Range(&quot;1:&quot; &amp; Rows.Count - actrow).Copy Destination:=Sheets(&quot;Sheet1&quot;).Range(actcell).Offset(1)
newsh.Range(&quot;1:&quot; &amp; Rows.Count - actrow).Delete
ttime = Time
ttime = WorksheetFunction.Replace(ttime, InStr(1, ttime, &quot;:&quot;), 1, &quot;&quot;)
ttime = WorksheetFunction.Replace(ttime, InStr(1, ttime, &quot;:&quot;), 1, &quot;&quot;)
Sheets(&quot;Sheet1&quot;).Name = &quot;Sheet1_&quot; &amp; ttime
newsh.Name = &quot;Sheet1&quot;
Else
ActiveCell.Offset(1).PasteSpecial
End If

Call macro_timer
End Sub

huangapple
  • 本文由 发表于 2023年7月13日 23:27:41
  • 转载请务必保留本文链接:https://go.coder-hub.com/76681071.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定