不会从第一列中获取价值

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

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笔记”允许用户从黄色字段获取所有数据并复制和粘贴笔记。

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

来源

2016-08-25 Rafael Clemente

**＆**用于连接文本值，** + **用于数学加法。你不应该试图将带有填充空格的text-that-looks-like-numbers相加，也不要将带有填充空格的text-that-looks-like-numbers与没有用CLng，CDbl等转换为真实数字的文本进行比较。 – Jeeped

如果没有看到“其他代码”或数据，我会怀疑你的[IsEmpty测试没有按照你的想法进行]（http://stackoverflow.com/a/38518107/4088852）。 – Comintern

请发表你的其他代码，你也错过了'End Function'，我肯定是一个输入错误 –

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

谢谢@Comintern

来源

2016-08-26 15:45:20

不会从第一列中获取价值

回答

相关问题