- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2025-7-5
|
本帖最後由 luhpro 於 2021-1-6 23:09 編輯
測試檔︰
需求a︰
當工作表A的B2︰B51=空白時，則將其同列A欄的值，轉置貼上工作表B的B104︰AX104
當工 ...
ziv976688 發表於 2021-1-5 18:22 
儲存格公式我始終不是看得很懂,
依據你短消息所說我這裡提供VBA程式的解決方式,
試試看.- Sub Tran()
- Dim iI1%, iI2%
- Dim lSum&, lRow%
- Dim shSou As Worksheet, shTar As Worksheet
-
- Set shSou = Worksheets("A")
- Set shTar = Worksheets("B")
- With shTar
- .Range(.[B104], .[AX268]).ClearContents
- End With
- With shSou
- For iI2 = 0 To 1
- For lRow = 2 To 18
- lSum = 0
- For iI1 = 2 To 51
- lSum = lSum + Cells(lRow, iI1)
- Next
- If lSum = 0 Then
- Debug.Print iI2 * 39 + lRow & " , " & 102 + iI2 * 98 + lRow
- .Cells(iI2 * 39 + lRow, 1).Resize(50).Copy
- shTar.Cells(102 + iI2 * 98 + lRow, 2).PasteSpecial Paste:=xlPasteAll, Transpose:=True
- End If
- Next
-
- For lRow = 2 To 19
- lSum = 0
- For iI1 = 2 To 51
- lSum = lSum + Cells(lRow, iI1)
- Next
- If lSum = 0 Then
- Debug.Print iI2 * 39 + 19 + lRow & " , " & 151 + iI2 * 98 + lRow
- .Cells(iI2 * 39 + 19 + lRow, 1).Resize(50).Copy
- shTar.Cells(151 + iI2 * 98 + lRow, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
- SkipBlanks:=False, Transpose:=True
- End If
- Next
- Next
- End With
- End Sub
|
|
發表於 2021-1-6 23:06
| 