根据当前区域粘贴用户输入

Question

我正在处理一组每周数据。每周，我都会在工作表中添加一组新数据。然后，我想提示用户输入并将其粘贴到当前区域范围内的特定列。现在，我的脚本将提示用户输入，然后查找工作表中最后一组数据的最后一行。然后，我使用当前区域来激活设置数据的第一行。由于数据将在col E到col O，我希望用户输入的输入位于col A到col D.

但是，当我运行我的脚本时，它不会从设置数据的第一行粘贴用户输入，也不会在设置数据的最后一行停止。基于该示例，我期望输出从第388行开始，最后在第406行。我从脚本获得的结果将粘贴到第404行，直到811.

现在我只试用一个名为＆＃34; setup＆＃34;的工作表。但后来我需要为20个不同名称的工作表修改我的脚本。

这是我的剧本：

{{1}}

这是前一周（第12周）数据的完整方式，用户输入数据和当前周（第13周）没有用户输入数据 https://pastebin.com/FnryFJh8

这是我从脚本中获得的结果

这是我期望得到的结果

Answer 1

您可以尝试这样的事情......

Dim Rng As Range
Set Rng = ws.Range("E:E").SpecialCells(xlCellTypeConstants, 2)
Set Rng = Rng.Areas(Rng.Areas.Count).Cells(1)

FirstRow = Rng.Row
If ws.Cells(FirstRow, 1) = "" Then
    LastRow = FirstRow
Else
    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
ws.Cells(LastRow, 1) = week
ws.Cells(LastRow, 2) = datedone
ws.Cells(LastRow, 3) = Data
ws.Cells(LastRow, 4) = Location

完整的代码应如下所示......

Public week, datedone, data, location As Variant

Sub pqr()
Dim ws As Worksheet
Dim x As Workbook
Dim LastRow As Long
Dim FirstRow As Long
Dim Rng As Range

week = InputBox("Week:")
datedone = InputBox("Date:")
data = InputBox("Data:")
location = InputBox("Location:")


Set x = ThisWorkbook
Set ws = Sheets("setup")

On Error Resume Next
Set Rng = ws.Range("E:E").SpecialCells(xlCellTypeConstants, 2)
On Error GoTo 0
If Not Rng Is Nothing Then
    Set Rng = Rng.Areas(Rng.Areas.Count).Cells(1)
    FirstRow = Rng.Row
    If ws.Cells(FirstRow, 1) = "" Then
        LastRow = FirstRow
    Else
        LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
    End If
    ws.Cells(LastRow, 1) = week
    ws.Cells(LastRow, 2) = datedone
    ws.Cells(LastRow, 3) = data
    ws.Cells(LastRow, 4) = location
End If
End Sub

<强> EDIT2：

Public week, datedone, data, location As Variant

Sub pqr()
Dim ws As Worksheet
Dim x As Workbook
Dim FirstRow As Long, LastRow As Long, n As Long

Dim Rng As Range

week = InputBox("Week:")
datedone = InputBox("Date:")
data = InputBox("Data:")
location = InputBox("Location:")


Set x = ThisWorkbook
Set ws = Sheets("setup")

On Error Resume Next
Set Rng = ws.Range("E:E").SpecialCells(xlCellTypeConstants, 2)
n = Rng.Areas(Rng.Areas.Count).Rows.Count
On Error GoTo 0
If Not Rng Is Nothing Then
    Set Rng = Rng.Areas(Rng.Areas.Count).Cells(1)
    FirstRow = Rng.Row
    LastRow = FirstRow + n - 1
    ws.Range(ws.Cells(FirstRow, 1), ws.Cells(LastRow, 1)) = week
    ws.Range(ws.Cells(FirstRow, 2), ws.Cells(LastRow, 2)) = datedone
    ws.Range(ws.Cells(FirstRow, 3), ws.Cells(LastRow, 3)) = data
    ws.Range(ws.Cells(FirstRow, 4), ws.Cells(LastRow, 4)) = location
End If
End Sub