Genie

中學生 Rank: 2

帖子: 113
主題: 31
精華: 0
積分: 149
點名: 0
作業系統: xp & vista
軟體版本: 2003 & 2007
閱讀權限: 20
註冊時間: 2010-12-29
最後登錄: 2020-5-22

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2012-9-21 09:36 | 只看該作者

請幫忙看一下插入欄這個程式問題出在哪

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

插入欄.zip (11.16 KB)

樓主熱帖

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兔年全勤獎章

2^#

發表於 2012-9-21 16:13 | 只看該作者

回復 1# Genie
選第二列的邏輯看不懂
選第一列如下

Sub 插入欄()
Dim i As Integer, r As String, Rng As Range, E As Range
Dim iRow As Integer
If iRow > 3 Then Exit Sub '此程式碼沒作用?? : iRow 程式中你尚未給值
Application.ScreenUpdating = False
Do
r = InputBox("輸入插入欄數,必須 >= 1 ", "插入欄數", "1")
Loop Until r <> "" And r >= 1
For i = 2 To [A2].End(xlToRight).Column - 1
If Cells(1, i) <> Cells(1, i + 1) Then
If Rng Is Nothing Then Set Rng = Cells(1, i) Else Set Rng = Union(Cells(1, i), Rng)
End If
Next
If Not Rng Is Nothing Then
For Each E In Rng.Cells
E.Offset(, 1).Resize(, r).EntireColumn.Insert
Next
End If
Application.ScreenUpdating = True
End Sub

複製代碼

TOP

Genie

中學生 Rank: 2

帖子: 113
主題: 31
精華: 0
積分: 149
點名: 0
作業系統: xp & vista
軟體版本: 2003 & 2007
閱讀權限: 20
註冊時間: 2010-12-29
最後登錄: 2020-5-22

3^#

發表於 2012-9-21 16:32 | 只看該作者

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

如選第二列
那就在 1、2、1、2、3、4 的後面插入空白欄

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^#

發表於 2012-9-21 17:41 | 只看該作者

回復 3# Genie
試試看

Sub 插入欄()
Dim i As Integer, r As String, Rng As Range, E As Range
Dim iRow As Integer
iRow = Selection.Cells(1).Row
If iRow > 3 Or Selection.Cells(1) = "" Then Exit Sub
Application.ScreenUpdating = False
Do
r = InputBox("輸入插入欄數,必須 >= 1 ", "插入欄數", "1")
Loop Until r <> "" And r >= 1
Set Rng = Cells(iRow, Columns.Count).End(xlToLeft)
Do
If Rng <> Rng.Offset(, -1) Then
Set Rng = Rng.Offset(, -1)
Rng.Offset(, 1).EntireColumn.Resize(, r).Insert
Else
Set Rng = Rng.Offset(, -1)
End If
Loop While Rng.Column > 2
Application.ScreenUpdating = True
End Sub

複製代碼

PS 按回覆鍵回文是一種禮貌

TOP

Genie

中學生 Rank: 2

帖子: 113
主題: 31
精華: 0
積分: 149
點名: 0
作業系統: xp & vista
軟體版本: 2003 & 2007
閱讀權限: 20
註冊時間: 2010-12-29
最後登錄: 2020-5-22

5^#

發表於 2012-9-21 23:55 | 只看該作者

回復 4# GBKEE

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

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

插入欄.zip (13.57 KB)

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兔年全勤獎章

6^#

發表於 2012-9-22 14:52 | 只看該作者

回復 5# Genie
你要在同一Sheet, 作兩次的插入欄,如附檔上的範例,
不好意思,我想不出程式碼的邏輯要如何寫.

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

7^#

發表於 2012-9-22 18:37 | 只看該作者

回復 1# Genie

你的意思不知是否如此

Sub InsertColumn()
Dim k
r = ActiveCell.Row
10
k = InputBox("輸入欲插入欄數", "插入欄數", 1)
If Not IsNumeric(k) Then MsgBox "請輸入有效數值 ": GoTo 10
i = Cells(r, 256).End(xlToLeft).Column
Do Until i = 2
If Cells(r, i) <> Cells(r, i - 1) And Cells(r, i - 1) <> "" And Cells(r, i) <> "" Then Cells(r, i).EntireColumn.Insert
i = i - 1
Loop
End Sub

複製代碼

學海無涯_不恥下問

TOP

Genie

中學生 Rank: 2

帖子: 113
主題: 31
精華: 0
積分: 149
點名: 0
作業系統: xp & vista
軟體版本: 2003 & 2007
閱讀權限: 20
註冊時間: 2010-12-29
最後登錄: 2020-5-22

8^#

發表於 2012-9-24 11:31 | 只看該作者

回復 7# Hsieh

可以做到我想要的樣子了
不過只可以插入一欄而已是嗎？
因為我輸入 2　要插入兩欄
但執行出來的結果只有插入一欄而已

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

9^#

發表於 2012-9-24 18:21 | 只看該作者

回復 8# Genie
忘了有多欄要求

Sub InsertColumn()
Dim k
r = ActiveCell.Row
10
k = InputBox("輸入欲插入欄數", "插入欄數", 1)
If Not IsNumeric(k) Then MsgBox "請輸入有效數值 ": GoTo 10
i = Cells(r, 256).End(xlToLeft).Column
Do Until i = 2
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
i = i - 1
Loop
End Sub

複製代碼

學海無涯_不恥下問

TOP

Genie

中學生 Rank: 2

帖子: 113
主題: 31
精華: 0
積分: 149
點名: 0
作業系統: xp & vista
軟體版本: 2003 & 2007
閱讀權限: 20
註冊時間: 2010-12-29
最後登錄: 2020-5-22

10^#

發表於 2012-9-25 15:25 | 只看該作者

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

TOP