求助 建表如何公式引用自动变化

lqf935258447

taller 发表于 2023-2-13 12:21

Sub demo()
    Set sht = ActiveSheet
       ActiveSheet.Copy After:=Sheets(Sheets.Count)
    Set newsht = ActiveSheet
Dim xStr As String
Retry:
   Err.Clear
   xStr = InputBox("请输入工作表的新名称：" _
       , "重命名工作表", ActiveSheet.Name)
    If xStr = "" Then Exit Sub
    On Error Resume Next
    ActiveSheet = xStr
    If Err.Number <> 0 Then
       MsgBox Err.Number & " " & Err.Description
       Err.Clear
       GoTo Retry
    End If
    On Error GoTo 0
    Range("B5:B10,B12:B21,B24").ClearContents
    newsht.[c5].Formula = "=" & sht.Name & "'!C5+B5"
End Sub
   

一样的

lqf935258447

半百 发表于 2023-2-13 13:33
替换表名？

啊？？？  替换表名成哪个？

半百

lqf935258447 发表于 2023-2-13 13:57
啊？？？  替换表名成哪个？

图上的两行红字，分别输入你原来的代码的第二行和倒数第二行。

lqf935258447

半百 发表于 2023-2-13 15:29
图上的两行红字，分别输入你原来的代码的第二行和倒数第二行。

2-3楼的老师都发了  我该改哪个

lqf935258447

半百 发表于 2023-2-13 15:29
图上的两行红字，分别输入你原来的代码的第二行和倒数第二行。

Sub CopyActiveSheetAndRename()
    Dim xStr As String
    Dim newSheet As Worksheet
    Dim dateStr As String
   
    dateStr = InputBox("请输入工作表的日期（格式为月.日）：", "输入日期")
   
    If dateStr = "" Then
        Exit Sub
    End If
   
    Set newSheet = ActiveSheet.Copy(After:=Sheets(Sheets.Count))
   
Retry:
    Err.Clear
    xStr = InputBox("请输入工作表的新名称（格式为月.日）：" _
       , "重命名工作表", dateStr)
    If xStr = "" Then
        Exit Sub




Sub demo()
    Set sht = ActiveSheet
       ActiveSheet.Copy After:=Sheets(Sheets.Count)
    Set newsht = ActiveSheet
Dim xStr As String
Retry:
   Err.Clear
   xStr = InputBox("请输入工作表的新名称：" _
       , "重命名工作表", ActiveSheet.Name)
    If xStr = "" Then Exit Sub
    On Error Resume Next
    ActiveSheet = xStr
    If Err.Number <> 0 Then
       MsgBox Err.Number & " " & Err.Description
       Err.Clear
       GoTo Retry
    End If
    On Error GoTo 0
    Range("B5:B10,B12:B21,B24").ClearContents
    newsht.[c5].Formula = "=" & sht.Name & "'!C5+B5"
End Sub




这两个吗 咋改呢
    End If
    On Error Resume Next
    newSheet.Name = xStr
    If Err.Number <> 0 Then
        MsgBox Err.Number & " " & Err.Description
        Err.Clear
        GoTo Retry
    End If
    On Error GoTo 0
   
    newSheet.Range("B5:B10,B12:B21,B24").ClearContents
    newSheet.Range("C5").Value = _
        Sheets(Replace(xStr, ".", ".") - 1).Range("C5").Value + newSheet.Range("B5").Value
    newSheet.Range("B26").Value = Sheets(Replace(xStr, ".", ".") - 1).Range("B30").Value
    newSheet.Range("B27").Value = Sheets(Replace(xStr, ".", ".") - 1).Range("B31").Value
End Sub

半百

lqf935258447 发表于 2023-2-13 15:36
2-3楼的老师都发了  我该改哪个

你自己的一楼的代码，我图上的两句代码分别加在最前和最后，然后套上SUB, END SUB.

lqf935258447

半百 发表于 2023-2-13 16:25
你自己的一楼的代码，我图上的两句代码分别加在最前和最后，然后套上SUB, END SUB.

一楼放的是我想要的了 ，我是想在这基础上 在加点，后面怎么加我就不会了。。我是想着 建表改名后，新表的B5和上一个表的C5相加并把数值返回到新建表的C5里 ，每日以此类推

tanglf188

上次帮你写的代码，错了一个参数，这次修改好了，你测试一下

半百

lqf935258447 发表于 2023-2-13 16:42
一楼放的是我想要的了 ，我是想在这基础上 在加点，后面怎么加我就不会了。。我是想着 建表改名后，新表 ...

试试，，，，，

taller

lqf935258447 发表于 2023-2-13 13:54
taller 发表于 2023-2-13 12:21

Sub demo()

上传示例文件包含代码，这些代码都是大家测试过的