- 帖子
- 559
- 主題
- 58
- 精華
- 0
- 積分
- 626
- 點名
- 0
- 作業系統
- win8
- 軟體版本
- office2013
- 閱讀權限
- 50
- 性別
- 男
- 來自
- TW
- 註冊時間
- 2010-11-22
- 最後登錄
- 2024-6-14
|
回復 13# waterfox
這是我上載檔案中的程式碼~- Private Sub CommandButton1_Click() '資料拋轉
- '======== A =>每一列跑的次數 ====================
- A = Sheet4.Range("IV2").End(xlToLeft).Column
- A = (A - 4) / 3
- If A - Int(A) > 0 Then
- MsgBox "資料欄位有誤"
- Exit Sub
- End If
- A = A - 1
- '======== B => 總共要跑的筆數 ====================
- B = Sheet4.Range("A65536").End(xlUp).Row
- For I = 3 To B
- Set C = Sheet2.Columns("B:B").Find(Sheet4.Range("B" & I))
-
- If Not C Is Nothing Then
- C = Sheet2.Columns("B:B").Find(Sheet4.Range("B" & I)).Row
- For J = 0 To A '(EX. 0->11 =12次)
- D = Sheet4.Cells(I, 7 + J * 3)
- If D = "" Then
- Else
- Do Until Sheet2.Range("F" & C + K) = ""
- If Sheet2.Range("F" & C + K) = D Then
- If Sheet4.Cells(I, 5 + J * 3) > 0 Then
- Sheet2.Cells(C + K, 7 + J) = Sheet4.Cells(I, 5 + J * 3)
- End If
- If Sheet4.Cells(I, 6 + J * 3) > 0 Then
- Sheet2.Cells(C + K, 21 + J) = Sheet4.Cells(I, 6 + J * 3)
- End If
- P = 1
- Exit Do
- End If
- K = K + 1
- Loop
- If P = 0 Then
- Sheet2.Rows(C + K).Insert Shift:=xlDown
- Sheet2.Range("F" & C + K) = Sheet4.Cells(I, 7 + J * 3)
- If Sheet4.Cells(I, 5 + J * 3) > 0 Then
- Sheet2.Cells(C + K, 7 + J) = Sheet4.Cells(I, 5 + J * 3)
- End If
- If Sheet4.Cells(I, 6 + J * 3) > 0 Then
- Sheet2.Cells(C + K, 21 + J) = Sheet4.Cells(I, 6 + J * 3)
- End If
- End If
- End If
- K = 0
- P = 0
- Next
- End If
- Next
- End Sub
複製代碼 |
|