Question

我有一个脚本将Julian日期转换为格里高利日期。我应该能够点击包含我的朱利安日期的范围，然后选择我想要插入格里高利日期的范围。唯一的问题是，一旦我将第一个选定的范围设置为JD（朱利安日期），我似乎无法分配新的选定范围。

例如，如果我选择B：B作为我的JD范围，那么JD = 2。

然后，如果我选择D：D作为我的GD（格里高利日期）范围，那么GD应该= 4，但它仍然等于2.我不确定在我通过之后还会出现什么错误有了这部分，但我现在已经被困在这里了。谁能提供任何见解？任何帮助表示赞赏！

Sub Julian_to_Gregorian()
    Dim rng As Range, col As Range, cols As Range, arr
    Dim sht As Worksheet, shet As Worksheet, hdr As Long, yn As Long, LastRow As Long
    Dim dest As Range

    On Error Resume Next
    Set rng = Application.InputBox( _
                Prompt:="Please select the column that contains the Julian Date. " & vbNewLine & _
                        " (e.g. Column A or Column B)", _
                Title:="Select Julian Date Range", Type:=8)
    On Error GoTo 0
    jd = Selection.Column
    'pjd = jd.Column

    hdr = MsgBox("Does your selection contain a header?", vbYesNo + vbQuestion, "Header Option")

    Set dest = Application.InputBox( _
                Prompt:="Please select the column that the Gregorian Date will be placed in. " & vbNewLine & _
                        "(A new column will be inserted in this location, preserving the current data in this location.)", _
                Title:="Select Destination Range", Type:=8)
      gd = Selection.Column
     If dest Is Nothing Then Exit Sub
     'gd = Selection.Column

     Set sht = dest.Parent
     Set shet = rng.Parent


     On Error GoTo 0
     'yn = MsgBox("Do you want to insert a new column here?" & vbNewLine & _
      '           "(Choosing 'No' will replace the current cells in your selected range." & vbNewLine & _
       '          "All data in this range will be permanently deleted.)", vbYesNo + vbQuestion, "Destination Range Options")


    LastRow = shet.Cells(Rows.Count, jd).End(xlUp).Row

    Application.ScreenUpdating = False
    'With Range(Cells(1, 3), Cells(1, 2 + Range("B1"))).EntireColumn
     With Cells(1, gd).EntireColumn
     .Insert Shift:=xlToRight
     End With
    'gd.EntireColumn.Insert xlRight
    gd = gd - 1
    For i = 2 To LastRow
    Cells(i, gd).Value = "=DATE(IF(0+(LEFT(" & Cells(i, jd) & ",2))<30,2000,1900)+LEFT(" & Cells(i, jd) & ",2),1,RIGHT(" & Cells(i, pjd) & ",3))"

    Next i
End Sub

Answer 1

我没有测试你的其余代码，但是要获得正确的列：

替换

jd = Selection.Column

jd = rng.Column

替换

gd = Selection.Column

gd = dest.Column

您的代码无法正常工作的原因很简单：您在提示期间激活的选择不是真实的＆＃34;在工作表中选择，它们仅对提示有效。提示之后，提示之前的选择将再次激活，因此，jd和gd将始终等于执行宏之前所选单元格的列。

Excel VBA使用户选择的范围变量永久

1 个答案: