2016-08-25 196 views
0

我有兩難處境。我有其他代碼將某些值向右移動,所以我可以輸入新數據。使用移動數據的代碼,即使有數據,此代碼也不會從第一列中獲取數據。它工作正常,無需移動數據。下面的代碼是複製的一部分並粘貼到文本字段中。如果我解釋這個不好,我很抱歉。不會從第一列中獲取價值

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 
+0

**&**用於連接文本值,** + **用於數學加法。你不應該試圖將帶有填充空格的text-that-looks-like-numbers相加,也不要將帶有填充空格的text-that-looks-like-numbers與沒有用CLng,CDbl等轉換爲真實數字的文本進行比較。 – Jeeped

+2

如果沒有看到「其他代碼」或數據,我會懷疑你的[IsEmpty測試沒有按照你的想法進行](http://stackoverflow.com/a/38518107/4088852)。 – Comintern

+0

請發表你的其他代碼,你也錯過了'End Function',我肯定是一個輸入錯誤 –

回答

0

我拿出IsEmpty,代碼做了我現在要做的事情。

謝謝@Comintern