請教excel 陣列問題 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 請教excel 陣列問題

返回列表下一主題上一主題發帖

請教excel 陣列問題

超級版主 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兔年全勤獎章

1^# 跳轉到 »

發表於 2015-7-12 15:41 | 顯示全部帖子

回復 1# lionliu
試試看

Option Explicit
Sub Ex()
Dim Rng As Range, i As Integer, Msg As Boolean
Set Rng = Sheets(1).[A2]
With Sheets(2)
.UsedRange.Clear '.UsedRange的範圍 < .Cells的範圍,處裡速度會快些
.Range("a1").Resize(, 4) = Array("Description", "Qty", "Price", "Amount") '一起給值
i = 2 '設定起始值
Do While Rng <> "" 'Rng ="" 迴圈停止
If Msg = False Then
.Cells(i, "A") = Rng.End(xlUp) & ": " & Rng
i = i + 1
End If
.Cells(i, "A") = Rng.Cells(1, 2).End(xlUp) & ": " & Rng.Cells(1, 2) 'item no
.Cells(i, "B").Resize(, 3) = Rng.Cells(1, 4).Resize(, 3).Value 'qty,price, amount
.Cells(i + 1, "A") = Rng.Cells(1, 3) 'Description
i = i + 2
Msg = False '設 po no 不相同
If Rng = Rng.Offset(1) Then Msg = True 'po no 相同
Set Rng = Rng.Offset(1) '下移一列
Loop
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 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兔年全勤獎章

2^#

發表於 2015-7-17 12:31 | 顯示全部帖子

回復 4# lionliu
這附檔與第1帖附檔格式不一樣.請再詳述這附檔的格式.

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 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兔年全勤獎章

3^#

發表於 2015-7-18 13:06 | 顯示全部帖子

回復 7# lionliu
不好意思,看不出附檔的規律性,VBA寫不出來.

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 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^#

發表於 2015-7-19 07:13 | 顯示全部帖子

回復 9# lionliu

第2帖的程式碼
Rng 不就是第一個工作表的Row
i 是第二個工作表的Row

Set Rng = Sheets(1).[A2]
05. With Sheets(2)
06. .UsedRange.Clear '.UsedRange的範圍 < .Cells的範圍,處裡速度會快些
07. .Range("a1").Resize(, 4) = Array("Description", "Qty", "Price", "Amount") '一起給值
08. i = 2 '設定起始值
09. Do While Rng <> "" 'Rng ="" 迴圈停止
10. If Msg = False Then

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 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兔年全勤獎章

5^#

發表於 2015-7-19 14:03 | 顯示全部帖子

回復 11# lionliu
是這樣嗎?

R = Rng.Cells(1, 8).Value
strcomma = WorksheetFunction.Find(",", R) '修改位置 H欄,
lenstr = Len(R)
dsc = Right(R, lenstr - strcomma)

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 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兔年全勤獎章

6^#

發表於 2015-7-20 13:45 | 顯示全部帖子

回復 13# lionliu
參考看看

Dim R As String '型態為字串
'這裡也要修改當作用中的工作表是工作表1時會有 "型態不符合的錯誤
'.Cells(i, 4) = Cells(i, 2) * Cells(i, 3) '修改位置 D欄由計算求值
.Cells(i, 4) = .Cells(i, 2) * .Cells(i, 3) '修改位置 D欄由計算求值

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

超級版主 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兔年全勤獎章

7^#

發表於 2015-7-20 20:05 | 顯示全部帖子

回復 15# lionliu
看看位置的差異

MsgBox rng.Cells(1, 8).Address '為何不是
MsgBox rng.Cells(i, 8).Address

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 自己害自己，莫過於亂發脾氣。

返回列表下一主題上一主題