Board logo

標題: 請幫忙看一下插入欄這個程式問題出在哪 [打印本頁]
作者: Genie    時間: 2012-9-21 09:36     標題: 請幫忙看一下插入欄這個程式問題出在哪

如 Excel 檔所附的　希望能做到 "選第一列"、"選第二列" 般的效果
但現在程式寫好了　執行時卻沒有插入空白欄
因為沒有出現錯誤訊息　所以我也不知道哪裡有問題
希望能幫我看一下
謝謝∼

[attach]12573[/attach]
作者: GBKEE    時間: 2012-9-21 16:13

回復 1# Genie
選第二列 的邏輯看不懂
選第一列 如下
  1. Sub 插入欄()
  2.     Dim i As Integer, r As String, Rng As Range, E As Range
  3.     Dim iRow As Integer
  4.     If iRow > 3 Then Exit Sub '此程式碼沒作用?? : iRow 程式中你尚未給值
  5.     Application.ScreenUpdating = False
  6.     Do
  7.         r = InputBox("輸入插入欄數,必須 >= 1  ", "插入欄數", "1")
  8.     Loop Until r <> "" And r >= 1
  9.     For i = 2 To [A2].End(xlToRight).Column - 1
  10.         If Cells(1, i) <> Cells(1, i + 1) Then
  11.             If Rng Is Nothing Then Set Rng = Cells(1, i) Else Set Rng = Union(Cells(1, i), Rng)
  12.         End If
  13.     Next
  14.     If Not Rng Is Nothing Then
  15.         For Each E In Rng.Cells
  16.             E.Offset(, 1).Resize(, r).EntireColumn.Insert
  17.         Next
  18.     End If
  19.     Application.ScreenUpdating = True
  20. End Sub
複製代碼
作者: Genie    時間: 2012-9-21 16:32

不管是選哪一列
就是在相同的文字或值後面插入 >1 的空白欄

如選第二列
那就在 1、2、1、2、3、4 的後面插入空白欄
作者: GBKEE    時間: 2012-9-21 17:41

回復 3# Genie
試試看
  1. Sub 插入欄()
  2.     Dim i As Integer, r As String, Rng As Range, E As Range
  3.     Dim iRow As Integer
  4.     iRow = Selection.Cells(1).Row
  5.     If iRow > 3 Or Selection.Cells(1) = "" Then Exit Sub
  6.     Application.ScreenUpdating = False
  7.     Do
  8.         r = InputBox("輸入插入欄數,必須 >= 1  ", "插入欄數", "1")
  9.     Loop Until r <> "" And r >= 1
  10.     Set Rng = Cells(iRow, Columns.Count).End(xlToLeft)
  11.     Do
  12.         If Rng <> Rng.Offset(, -1) Then
  13.             Set Rng = Rng.Offset(, -1)
  14.             Rng.Offset(, 1).EntireColumn.Resize(, r).Insert
  15.         Else
  16.             Set Rng = Rng.Offset(, -1)
  17.         End If
  18.     Loop While Rng.Column > 2
  19.     Application.ScreenUpdating = True
  20. End Sub
複製代碼
PS 按回覆鍵 回文 是一種禮貌
作者: Genie    時間: 2012-9-21 23:55

回復 4# GBKEE

這個程式若要在同個 sheet 連續執行兩次的話
是不是會把第一次執行的空白欄也當做一欄再插入？
例如先選第一列插入空白欄　再選第二列插入空白欄
結果會把第一列插入的空白欄　也當做一欄插入
如附檔所示

請問是否可以不把第一列的空白欄也當作一欄做插入呢？
謝謝∼

[attach]12585[/attach]
作者: GBKEE    時間: 2012-9-22 14:52

回復 5# Genie
你要在同一Sheet, 作兩次的插入欄,如附檔上的範例,
不好意思,我想不出程式碼的邏輯要如何寫.
作者: Hsieh    時間: 2012-9-22 18:37

回復 1# Genie

你的意思不知是否如此
  1. Sub InsertColumn()
  2. Dim k
  3. r = ActiveCell.Row
  4. 10
  5. k = InputBox("輸入欲插入欄數", "插入欄數", 1)
  6. If Not IsNumeric(k) Then MsgBox "請輸入有效數值 ": GoTo 10
  7. i = Cells(r, 256).End(xlToLeft).Column
  8. Do Until i = 2
  9. If Cells(r, i) <> Cells(r, i - 1) And Cells(r, i - 1) <> "" And Cells(r, i) <> "" Then Cells(r, i).EntireColumn.Insert
  10. i = i - 1
  11. Loop
  12. End Sub
複製代碼
作者: Genie    時間: 2012-9-24 11:31

回復 7# Hsieh

可以做到我想要的樣子了
不過只可以插入一欄而已是嗎？
因為我輸入 2　要插入兩欄
但執行出來的結果只有插入一欄而已
作者: Hsieh    時間: 2012-9-24 18:21

回復 8# Genie
忘了有多欄要求
  1. Sub InsertColumn()
  2. Dim k
  3. r = ActiveCell.Row
  4. 10
  5. k = InputBox("輸入欲插入欄數", "插入欄數", 1)
  6. If Not IsNumeric(k) Then MsgBox "請輸入有效數值 ": GoTo 10
  7. i = Cells(r, 256).End(xlToLeft).Column
  8. Do Until i = 2
  9. If Cells(r, i) <> Cells(r, i - 1) And Cells(r, i - 1) <> "" And Cells(r, i) <> "" Then Cells(r, i).Resize(, k).EntireColumn.Insert
  10. i = i - 1
  11. Loop
  12. End Sub
複製代碼
作者: Genie    時間: 2012-9-25 15:25

謝謝 GBKEE 和 Hsieh 版大的幫忙
解決了我的問題
也讓我學習不同的寫法
這幾個程式我會好好研究的
非常謝謝幫忙∼



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