- 帖子
- 27
- 主題
- 12
- 精華
- 0
- 積分
- 318
- 點名
- 66
- 作業系統
- Windows
- 軟體版本
- 7
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-7-20
- 最後登錄
- 2025-3-12
      
|
回復 2# GBKEE
跑出來了 謝謝版主
但我想再稍作修改 像下圖
我土法煉鋼改成以下這樣
但是好像不對
我還想請問向中間沒數值的話
會有空白列 可以不要有空白嗎
如果要修改字型的話 要放在迴圈內還是迴圈外
煩請版主為小弟解惑一下
Sub Ex()
Dim Ar(), E As Range, Msg$, i%, y%, C%
Ar = Array("a2", "g2", "a8", "g8")
C = 4
For i = 1 To Sheet1.[C2:F6].Columns.Count
Msg = ""
y = 0
For Each E In [C2:F6].Columns(i).Cells
If E <> "" Then
Msg = IIf(Msg <> "", Msg & Chr(10), "") & "在" & Cells(E.Row, 1) & "店買了" & Cells(E.Row, 2) & E & "枝"
y = y + 1
End If
Next
Sheet2.Range(Ar(i - 1)) = IIf(Msg <> "", Msg & Application.Rept(Chr(10), IIf(y < C, C - y, 0)) & IIf(y < C, "請至A店取貨", ""), "")
Next
For i = 1 To Sheet1.[C7:F11].Columns.Count
Msg = ""
y = 0
For Each E In [C7:F11].Columns(i).Cells
If E <> "" Then
Msg = IIf(Msg <> "", Msg & Chr(10), "") & "在" & Cells(E.Row, 1) & "店買了" & Cells(E.Row, 2) & E & "枝"
y = y + 1
End If
Next
Sheet2.Range(Ar(i - 1)) = IIf(Msg <> "", Msg & Application.Rept(Chr(10), IIf(y < C, C - y, 0)) & IIf(y < C, "請至B店取貨", ""), "")
Next
End Sub |
|
發表於 2010-8-15 14:11
| 
