Board logo

標題: [發問] i甚麼時候+數 , 又怎樣可以變回零又到相關位置再次計算? [打印本頁]
作者: joslau    時間: 2014-2-14 11:57     標題: i甚麼時候+數 , 又怎樣可以變回零又到相關位置再次計算?

大家好

sub addcomma是合併所需要資料合併成合併資料的模樣

http://forum.twbts.com/viewthread.php?tid=10512&highlight=

多得stillfish00大大的幫助已可將所需資料合併

但我寫了一個星期仍未可寫出
選取資料後執行addcomma貼到所需位置
再刪除無用資料...

試了用Resize做選取資料
OFFSET做移動
但因有i是變數
行數也是變數而變得困難...

請問i = 變數時的使用上的秘訣?
即
i = Worksheets("sheet1").Range("a2").End(xlDown).Row
之類
A2又可以怎樣重新定義?

[attach]17491[/attach]
[attach]17490[/attach]

謝謝
作者: GBKEE    時間: 2014-2-14 12:40

回復 1# joslau
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ar(), i As Integer, S As Integer
  4.     i = 2
  5.     With ActiveSheet
  6.         Do While .Cells(i, "C") <> ""
  7.             If .Cells(i, "A") & .Cells(i, "B") <> "" Then
  8.                 S = S + 1
  9.                 ReDim Preserve Ar(1 To 4, 1 To S) '陣列:重置 第二維的元素上限值
  10.                 Ar(1, S) = .Cells(i, "A")
  11.                 Ar(2, S) = .Cells(i, "B")
  12.                 Ar(3, S) = .Cells(i, "C")
  13.                 Ar(4, S) = .Cells(i, "C")
  14.             Else
  15.                 Ar(4, S) = Ar(4, S) & "," & .Cells(i, "C")
  16.             End If
  17.             i = i + 1
  18.         Loop
  19.         .Range("F2").Resize(S, 4) = Application.Transpose(Ar)
  20.     End With
  21. End Sub
複製代碼
作者: stillfish00    時間: 2014-2-14 14:08

本帖最後由 stillfish00 於 2014-2-14 14:09 編輯

回復 1# joslau
參考:
  1. Sub Test()
  2.   Dim rngSource As Range, rngTarget As Range
  3.   Dim ar, i As Long, j As Long
  4.   
  5.   With Sheets("Sheet1")
  6.     Set rngSource = .[A1].CurrentRegion.Resize(, 3) '來源
  7.     Set rngTarget = .[G1].Resize(rngSource.Rows.Count, 3) '合併結果
  8.    
  9.     '刪除舊的結果
  10.     If rngTarget.Cells(1).Value <> "" Then rngTarget.Cells(1).CurrentRegion.ClearContents
  11.    
  12.     '合併
  13.     ar = rngSource.Value  '一次性取出
  14.     For i = 1 To UBound(ar)
  15.       If ar(i, 1) <> "" Then
  16.         j = j + 1
  17.         rngTarget.Cells(j, 1).Resize(, 3) = Application.Index(ar, i)
  18.       Else
  19.         rngTarget.Cells(j, 3).Value = rngTarget.Cells(j, 3).Value & "," & ar(i, 3)
  20.       End If
  21.     Next
  22.   End With
  23. End Sub
複製代碼
作者: joslau    時間: 2014-2-14 14:43

本帖最後由 joslau 於 2014-2-14 14:46 編輯

回復 2# GBKEE
回復 3# stillfish00


先謝謝
兩位提點供出原始碼作參考
需要時間研究

因單號會有長短
合併時因過長有機會數據變成"12,345,678,911,234,500,000"等等
需要加 " ' "在頭

如再有問題或成果
會再回覆主題
作者: joslau    時間: 2014-2-14 15:09

已解決
  1. rngTarget.Cells(j, 3).Value = rngTarget.Cells(j, 3).Value & "," & ar(i, 3)
複製代碼
改成
  1. rngTarget.Cells(j, 3).Value = [color=Red]"'" &[/color] rngTarget.Cells(j, 3).Value & "," & ar(i, 3)
複製代碼
我會再研究以上原始碼的用法


謝謝!!!



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)