返回列表 上一主題 發帖

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

回復 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
複製代碼

TOP

回復 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 按回覆鍵 回文 是一種禮貌

TOP

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

TOP

        靜思自在 : 君子為目標,小人為目的。
返回列表 上一主題