帖子: 45
主題: 19
精華: 0
積分: 84
點名: 0
作業系統: Windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-9
最後登錄: 2015-4-14

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2013-3-11 11:10 | 只看該作者

儲存格程式該如何陣列循環

儲存格程式該如何陣列循環
如附件

1.rar (10.52 KB)

樓主熱帖

mark15jill

　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生 Rank: 3 Rank: 3

帖子: 852
主題: 79
精華: 0
積分: 918
點名: 0
作業系統: Windows 7 , XP
軟體版本: Office 2007, Office 2003,Office 2010,YoZo Office
閱讀權限: 50
性別: 男
來自: 宇宙
註冊時間: 2011-4-8
最後登錄: 2024-2-21

2^#

發表於 2013-3-11 11:29 | 只看該作者

回復 1# yueh0720

k1 = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
簡易的解法..
另附上若P有數值，則C-N 以淡藍色顯示
For ap = 1 To k1
If Cells(ap, "p") <> "" Then
For ap1 = 3 To 14
Cells(ap, ap1) = Cells(ap, ap1 + 13)
Cells(ap, ap1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Next
End If
Next

複製代碼

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

TOP

yueh0720

中學生 Rank: 2

帖子: 45
主題: 19
精華: 0
積分: 84
點名: 0
作業系統: Windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-9
最後登錄: 2015-4-14

3^#

發表於 2013-3-11 11:46 | 只看該作者

回復 2# mark15jill

儲存格C3會出現" ActiveSheet.Paste"
顏色部分會出現錯誤，將此3項忽略則OK
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2013-3-11 13:02 | 只看該作者

回復 1# yueh0720

Sub Ex()
Dim i As Integer
'With 在一個單一物件或一個使用者自訂型態上執行 -> 一系列的陳述式。
With ActiveSheet '作用中的工作表
'*** 一系列的陳述式前面有一 . (點) 表為 ActiveSheet的Cells(i, "P")
'例: .Cells(i, "A"), 例: .Cells(i, "C"), 例: .Cells(i, "P")
i = 2
Do While .Cells(i, "A") <> "" '執行Do的條件: 由A2往下直到A欄的儲存格無資料
If .Cells(i, "P") <> "" And IsNumeric(.Cells(i, "P")) Then
'<> ""(不是空白) AND 是數值
.Cells(i, "C").Resize(1, 12) = .Cells(i, "P").Resize(1, 12).Value
'.Resize(1, 12)->傳回 1列,12欄的範圍
'Resize 屬性調整指定的範圍。傳回 Range 物件，該物件代表調整後的範圍。
End If
i = i + 1
Loop
End With
End Sub

複製代碼

TOP

mark15jill

　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生 Rank: 3 Rank: 3

帖子: 852
主題: 79
精華: 0
積分: 918
點名: 0
作業系統: Windows 7 , XP
軟體版本: Office 2007, Office 2003,Office 2010,YoZo Office
閱讀權限: 50
性別: 男
來自: 宇宙
註冊時間: 2011-4-8
最後登錄: 2024-2-21

5^#

發表於 2013-3-11 16:34 | 只看該作者

回復 mark15jill

儲存格C3會出現" ActiveSheet.Paste"
顏色部分會出現錯誤，將此3項忽略則OK
.Th ...
yueh0720 發表於 2013-3-11 11:46

以下這段可選擇要不要+...
            Cells(ap, ap1).Select

         With Selection.Interior

            .Pattern = xlSolid

            .PatternColorIndex = xlAutomatic

            .ThemeColor = xlThemeColorAccent5

            .TintAndShade = 0.599993896298105

            .PatternTintAndShade = 0

         End With

      Next

End If

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 277
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-12-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2013-3-11 19:42 | 只看該作者

回復 1# yueh0720

Sub ex()
With ActiveSheet
For Each a In .Range("P:P").SpecialCells(xlCellTypeConstants, xlNumbers) 'P欄數值儲存格
With a.Offset(, -13).Resize(, 12)
.Value = a.Resize(, 12).Value
End With
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP