Question

我陷入两难境地。我有其他代码将一些值移动到右边，所以我可以输入新数据。使用移动数据的代码，即使存在数据，此代码也不会从第一列获取数据。它可以正常工作而无需移动数据。下面的代码是副本的一部分并粘贴到文本字段中。如果我解释这个不好，我很抱歉。

Dim LabValues As String
Dim LabColumns As Integer
Dim LabCounter As Integer
Dim EmptyRow As Integer

    Private Function tpnForm(LabValues As String)

    '**Volume*
    EmptyRow = Cells(34, 10).Value2 + Cells(34, 11).Value2 + Cells(34, 12).Value2 + Cells(34, 13).Value2 + Cells(34, 14).Value2 + Cells(34, 15).Value2 + Cells(34, 16).Value2

    If EmptyRow > 0 Then
        LabValues = LabValues & "Volume:       "
        LabColumns = 10

        Do Until LabColumns = 17
            If Not IsEmpty(Cells(2, LabColumns)) Then
                If Cells(34, LabColumns).Value > 0 Then
                    LabValues = LabValues & Cells(34, LabColumns).Value & "                "
                Else
                    LabValues = LabValues & "                        "
                End If
            End If
            LabColumns = LabColumns + 1
        Loop
        LabValues = LabValues & vbNewLine
    End If                  

End Function

image of entered data如果我点击“完整/实验室移动”或“完整/没有实验室移动”，则会生成一个新选项卡并为其命名。同时将数据移到右侧，这样我就可以从不同的日期输入新数据。 “HCN Note”允许用户从黄色字段中获取所有数据并制作复制和粘贴注释。

Sub CopySheet()
    Dim wb As Workbook, ws As Worksheet, nws As Worksheet

    'set up
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets(1)
    'Create a copy of the worksheet
    ws.Copy wb.Worksheets(1) 'places the worksheet at the front
    Set nws = wb.Worksheets(1) 'References the new front worksheet
    'set a name for the new sheet for easy reference
    nws.Name = InputBox("Enter Assessment Date mmddyy")

    'Print out the actual value you want rather than copy and paste.
'****Copy Assessment Date to the Nourish Report Printable****
    nws.Range("V96").Value = ws.Range("C74").Value
'*****Copy Subjective to to New Sheet****
    nws.Range("A41:F47").Value = ws.Range("A41:F47").Value
'******Copy Nutritionally Pertinent Meds to the New Sheet*****
    nws.Range("A50:F50").Value = ws.Range("A50:F50").Value
'******Copy Assessment / Nutrition Diagnosis to New Sheet*****A53:F56
    nws.Range("A53:F56").Value = ws.Range("A53:F56").Value
'*****Copy Nutrition Therapy Goals to New Sheet******A59:F63
    nws.Range("A59:F63").Value = ws.Range("A59:F63").Value
'******Copy Plan of Care to New Sheet******A66:F72
    nws.Range("A66:F72").Value = ws.Range("A66:F72").Value

'******Delete Weight*****
    Sheet1.Select
    Range("B8").Select
    Selection.ClearContents
'*****Delete Subjective****
    Range("A41").Select
    Selection.ClearContents
'*****Delete Assessment / Nutrition Diagnosis*****
    Range("A53").Select
    Selection.ClearContents
'*****Delete Nutrition Therapy Goals****
    Range("A59").Select
    Selection.ClearContents
'***Delete Plan of Care Recommendations****
    Range("A66").Select
    Selection.ClearContents
'*****Delete Education*****
    Range("B75").Select
    Selection.ClearContents
'*****Delete Discussed With****
    Range("B76").Select
    Selection.ClearContents
'*****Delete Last Evaluation Completed On****
    Range("D79").Select
    Selection.ClearContents
'*****Delete Assessment Type****
    Range("B21").Select
    Selection.ClearContents
'******Delete Oral / Tube Feedings ****
 Range("D25").Select
    Selection.ClearContents
    Range("D27").Select
    Selection.ClearContents
    Range("D29").Select
    Selection.ClearContents
'*****Delete Today's Date****
    Range("C74").Select
    Selection.ClearContents
    Range("F12").Select
    Sheets("New").Select
    Range("F12").Select


'***Move Labs over right****
    Worksheets("New").Select
    Range("J2:O12").Select
    Selection.Copy
    Range("K2").Select
    ActiveSheet.Paste
    Range("J2:J12").Select
    Selection.ClearContents
    Range("J14:O29").Select
    Selection.Copy
    Range("K14").Select
    ActiveSheet.Paste
    Range("J14:J29").Select
    Selection.ClearContents

    Range("K34:O41").Select
    Selection.Copy
    Range("L34").Select
    ActiveSheet.Paste

    Range("K34").Value = Range("J34").Value
    Range("K35").Value = Range("J35").Value
    Range("K36").Value = Range("J36").Value
    Range("K37").Value = Range("J37").Value
    Range("K38").Value = Range("J38").Value
    Range("K39").Value = Range("J39").Value
    Range("K40").Value = Range("J40").Value
    Range("K41").Value = Range("J41").Value


    Range("K43:O50").Select
    Selection.Copy
    Range("L43").Select
    ActiveSheet.Paste
    Range("K43").Value = Range("J43").Value
    Range("K44").Value = Range("J44").Value
    Range("K45").Value = Range("J45").Value
    Range("K46").Value = Range("J46").Value
    Range("K47").Value = Range("J47").Value
    Range("K48").Value = Range("J48").Value
    Range("K49").Value = Range("J49").Value
    Range("K50").Value = Range("J50").Value

    ws.Activate 'select old worksheet

End Sub

Answer 1

我拿出了IsEmpty，代码完成了我现在要做的事情。

谢谢@Comintern

不从第一列

1 个答案: