Note: The other languages of the website are Google-translated. Back to English

如何根據Excel中的單元格值將整行移動到活動工作表的底部?

若要根據Excel中的單元格值將整個行移動到活動工作表的底部,請嘗試本文中的VBA代碼。

使用VBA代碼根據單元格值將整個行移到活動工作表的底部


使用VBA代碼根據單元格值將整個行移到活動工作表的底部

例如,如下面的屏幕快照所示,如果C列中的單元格包含某個值“ Done”,則將整行移動到當前工作表的底部。 請執行以下操作。

1。 按 其他+ F11 同時打開 Microsoft Visual Basic for Applications 窗口。

2。 在裡面 Microsoft Visual Basic for Applications 窗口中,單擊 插入 > 模塊。 然後將下面的VBA代碼複製並粘貼到窗口中。

VBA代碼:根據單元格的值將整個行移到活動工作表的底部

Sub MoveToEnd()
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xEndRow As Long
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
lOne:
    Set xRg = Application.InputBox("Select range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Or xRg.Areas.Count > 1 Then
        MsgBox " Multiple ranges or columns have been selected ", vbInformation, "Kutools for Excel"
        GoTo lOne
    End If
    xEndRow = xRg.Rows.Count + xRg.Row
    Application.ScreenUpdating = False
    For I = xRg.Rows.Count To 1 Step -1
        If xRg.Cells(I) = "Done" Then
           xRg.Cells(I).EntireRow.Cut
           Rows(xEndRow).Insert Shift:=xlDown
        End If
    Next
    Application.ScreenUpdating = True
End Sub

備註:在VBA代碼中,“完成”是您將基於其移動整行的單元格值。 您可以根據需要進行更改。

3。 按 F5 鍵運行代碼,然後在彈出窗口中 Excel的Kutools 對話框中,選擇存在特定值的列範圍,然後單擊 OK 按鈕。

點擊後 OK 按鈕,將在指定列中包含值“完成”的整行自動移至數據范圍的底部。


相關文章:


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (28)
4.75中的5評分 · 2評級
網站主持人對此評論進行了最小化
我怎樣才能做到讓 kutools 在沒有用戶輸入的情況下選擇特定的行?
網站主持人對此評論進行了最小化
嗨,Anon,
對不起,我不確定你的意思。 如果您能再次解釋一下或提供屏幕截圖來顯示您正在嘗試做什麼,那就太好了。
謝謝你的評論。
網站主持人對此評論進行了最小化
嗨,水晶,這段代碼很好用,謝謝。 我想將 D 列中包含“完成”一詞的所有行移到表格頂部(插入第 3 行)。 那可能嗎? 然後我想刪除所有這些在 V 列中包含“昨天日期”的完整行。
網站主持人對此評論進行了最小化
你好。 這對於我想要的幾乎是完美的。 我有與 Anon 相同的請求的一部分,必須在沒有用戶輸入的情況下完成這項工作以及一些額外內容。

我想知道是否可以將唯一的列搜索為 i4 到 i50 並讓它在打開時或任何時候在編輯 i 列時自動運行。 此外,如果可以將行移動到工作表的底部,而“完成”行和“否”行之間沒有任何空白行。 目前,如果我選擇 i4:i50 並且如果我只有第 25 行的數據,它將粘貼從第 50 行而不是第 25 行升序的“完成”行。我的工作表中的行數不斷變化,不應該到達超過50個。感謝您的幫助。
網站主持人對此評論進行了最小化
嗨布蘭登,
對不起,可以幫助你。 感謝您的評論。
網站主持人對此評論進行了最小化
您好,有沒有辦法對此進行調整,以便將一行移動到同一工作表中除末尾之外的其他位置? 我有一張表,其中包含已過期的訂單和尚未過期的即將到來的訂單的訂單信息,並且我擁有它,因此當我在 A 列中放置“X”時,會根據零件編號和運輸地點突出顯示和加粗。 現在我必須實際剪切並粘貼新日期(發貨日期),以便它適合按日期排序的頂部(第 1 天到月底)。 到目前為止,我已經能夠有條件地格式化所有內容,但我認為我不能那樣移動行。 我想知道VBA是否可以做到這一點,在輸入日期時移動一行以適應其他日期行?
網站主持人對此評論進行了最小化
你好,我可以讓它工作的唯一方法是如果我在 Visual Basic 子屏幕中“運行”宏。 一旦用戶輸入“完成”,是否可以讓這個 VBA 代碼自動運行? 每次我得到 Kutools for Excel 對話框彈出詢問我請求代碼搜索的參數。 我已經通過將 xTxt = ActiveSheet.UsedRange.AddressLocal 替換為我需要搜索的參數並按回車來解決這個問題。 但是如果輸入“完成”後自動進行更改會更方便。 謝謝!
網站主持人對此評論進行了最小化
嗨,Anon,
下面的 VBA 代碼可以幫你一個忙。 請試一試。
請右鍵單擊工作表選項卡(工作表包含您將移動到底部的數據),從上下文菜單中選擇查看代碼並將以下代碼複製到代碼窗口中。

Private Sub Worksheet_Change(ByVal Target As Range)
'更新者 Extendoffice 20190925
將 xRg 調暗為範圍
將 xIRg 調暗為範圍
將 xTxt 調暗為字符串
將 xCell 調暗為範圍
將 xEndRow 變暗
暗淡我只要
將 xDStr 調暗為字符串
在錯誤恢復下一頁
xDStr = "C:C"
設置 xRg = Me.Range(xDStr)
設置 xIRg = Application.Intersect(Target, xRg)
如果 xIRg 什麼都不是,則退出 Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

如果目標 = “完成” 那麼
xEndRow = ActiveSheet.UsedRange.Rows.Count + 1
目標.EntireRow.Cut
行(xEndRow)。插入 Shift:=xlDown
如果結束
Application.EnableEvents = True
Application.ScreenUpdating = True
END SUB
網站主持人對此評論進行了最小化
嗨水晶,

感謝您發布此代碼。 如果 Done 輸入錯誤,我想知道如何讓代碼將行移回頂部。 是否可以為“移動”添加輔助代碼以將其移動到頂部,並為底部添加“完成”?
網站主持人對此評論進行了最小化
你好水晶你給匿名的代碼讓vba自動運行代碼很棒但是我不能插入一行行有沒有可能的方法來修復它
網站主持人對此評論進行了最小化
嗨,莎拉,
帶來不便敬請諒解。 請嘗試以下 VBA。 謝謝。

Private Sub Worksheet_Change(ByVal Target As Range)

'更新者 Extendoffice 20200424

將 xRg 調暗為範圍

將 xIRg 調暗為範圍

將 xTxt 調暗為字符串

將 xCell 調暗為範圍

將 xEndRow 變暗

暗淡我只要

將 xDStr 調暗為字符串

出錯時轉到 Err1

xDStr = "C:C"

設置 xRg = Me.Range(xDStr)

設置 xIRg = Application.Intersect(Target, xRg)

如果 xIRg 什麼都不是,則退出 Sub

Application.ScreenUpdating = False

Application.EnableEvents = False



如果 Target.Value = "Done" 那麼

'xEndRow = ActiveSheet.UsedRange.Rows.Count + 1

xEndRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1

目標.EntireRow.Cut

行(xEndRow)。插入 Shift:=xlDown

如果結束

錯誤1:

Application.EnableEvents = True

Application.ScreenUpdating = True

END SUB
網站主持人對此評論進行了最小化
我試圖複製此代碼,但它繼續說無效使用我。
網站主持人對此評論進行了最小化
如果只需要在 A 列和 B 列下移動行怎麼辦? 那麼C列應該保留嗎? 我們還應該使用 EntireRow 嗎?
網站主持人對此評論進行了最小化
嗨傑雷爾,
試試下面的代碼。 希望我能幫上忙。

子 MoveToEnd()

'更新者 Extendoffice 20200717

將 xRg 調暗為範圍

將 xTxt 調暗為字符串

將 xCell 調暗為範圍

將 xEndRow 變暗

將 xIntR 調暗為整數

暗淡我只要

將 xWs 調暗為工作表

在錯誤恢復下一頁

如果 ActiveWindow.RangeSelection.Count > 1 那麼

xTxt = ActiveWindow.RangeSelection.AddressLocal

其他

xTxt = ActiveSheet.UsedRange.AddressLocal

如果結束

l 一個:

Set xRg = Application.InputBox("選擇範圍:", "Kutools for Excel", xTxt, , , , , 8)

如果 xRg 什麼都不是,則退出 Sub

如果 xRg.Columns.Count > 1 或 xRg.Areas.Count > 1 那麼

MsgBox "已選擇多個範圍或列", vbInformation, "Kutools for Excel"

轉到lOne

如果結束

xEndRow = xRg.Rows.Count + xRg.Row

xWs = xRg.工作表

xWs.激活

Application.ScreenUpdating = False

對於 I = xRg.Rows.Count 到 1 步 -1

如果 xRg.Item(I) = "完成" 那麼

行(xEndRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

xIntR = xRg.Cells(I).Row

範圍(“A”&xIntR&“:B”&xIntR)。選擇

Selection.Cut

範圍(“A”和 xEndRow)。選擇

ActiveSheet.Paste

xEndRow = xEndRow + 1



如果結束

下一頁

Application.ScreenUpdating = True

END SUB
網站主持人對此評論進行了最小化
你好,



我在使用提供的代碼時遇到問題,並且不斷收到語法錯誤。 我是超級新手,我一直在嘗試自學經營家庭企業所需的知識。 我有一個庫存電子表格 ID,希望能夠將列中的項目指定為已退休? 是/否,如果是,它們按字母順序移動到工作表的底部,而不會在主電子表格中留下空白。 我們有物品完全退役,然後回來進行限量的特別重新發布,並且像這些物品一樣存儲在我的工作表底部,直到它們再次可用。 謝謝你。
網站主持人對此評論進行了最小化
你好,我有一個老闆交給我的任務。 起初看起來很簡單,但現在我對如何進行感到困惑。 我們有一個可能工作的預測表,它們有一個按百分比表示的“訂單概率”列。 他要我設置 3 個不同的表,分別為 100-70%、69%-41 和 40-0%。 這個想法是,當信息輸入到主工作表中時,當輸入百分比時,它會自動複製到與該百分比範圍匹配的後續工作表中。 我用一個簡單的 IF(和公式)做到了這一點。但是我需要排序以鬆開空單元格並使其看起來更乾淨。然後當我排序時,如果我向主表添加新的 Oder Probability 報價,它不會自動顯示它,無需取消排序然後再次排序。如果這個問題不屬於她,我深表歉意。但是有沒有我可以輸入的代碼字符串可以更輕鬆地處理這個問題?確定整行是否移動的唯一值是K列。看起來很簡單,但對於這個excel初學者來說卻很複雜。在此先感謝您的幫助。
網站主持人對此評論進行了最小化
如果“完成”只是列字符串的一部分,該怎麼辦。 假設我的列包含諸如 XYZDone、ABCDone、123Done 等值,我可以根據部分字符串“Done”過濾掉嗎?
網站主持人對此評論進行了最小化
嗨水晶,
感謝您的幫助,代碼運行良好,但不是將行移動到頁面底部,如何將其移動到另一個選項卡,即“關閉”選項卡?
網站主持人對此評論進行了最小化
嗨,
抱歉這麼晚才回复。
在代碼中,您只需要更改“如果 xRg.Cells(I) = "完成" 那麼“ 至 如果 xRg.Cells(I) 喜歡 "*Done*" 那麼 完成它。
網站主持人對此評論進行了最小化
我有一個帶有復選框的列表,當一列被選中時,我需要它轉到電子表格的一個部分,如果另一個被選中,它會轉到最後。 我已經嘗試了一百種不同的方法來做到這一點,有人可以幫忙嗎?
網站主持人對此評論進行了最小化
你好! 我剛剛購買了 kutools,這樣我就可以將這個 vba 代碼 *** 到我的 excel 表中,因為這將是一個很好的功能! 上面的說明簡單而有用; 但是,一旦我進入將代碼複製並粘貼到窗口中並按 F5 的步驟,它會將我發送到一個框來命名和創建宏。 我這樣做了,但現在它不會帶我進入對話框,所以我可以選擇單元格範圍。 彈出“無效的外部過程”的編譯錯誤。 請幫忙!
網站主持人對此評論進行了最小化
嗨,
很抱歉誤導了你。 該代碼可以單獨使用,不需要購買 Kutools。 如果您不需要,請發郵件至sales@extendoffice.com 要求退款。
為了使代碼順利運行,您需要確保您的光標位於代碼窗口中(單擊代碼中的任何單詞),然後按 F5 運行代碼的關鍵。 然後會彈出選擇單元格範圍的對話框。
再次抱歉給您帶來不便。
網站主持人對此評論進行了最小化
又是我! 我想出了代碼。 我手動複製並粘貼了代碼,而不是使用屏幕右上角的複制按鈕。 我將“完成”更改為“x”。 我已經在每個工作表中運行了代碼。 當我開始在對話框中選定單元格範圍內的那些單元格中輸入“x”時,什麼也沒有發生(行不會自動向下移動到底部)。 我對此很陌生....感謝您的幫助!
網站主持人對此評論進行了最小化
嗨,
如果您想在輸入指定單詞時自動將行移到底部,請嘗試以下 VBA 代碼。
備註:您需要在工作表代碼窗口中輸入代碼(右鍵單擊工作表選項卡並從上下文菜單中選擇查看代碼)。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Extendoffice 20220520
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xEndRow As Long
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
lOne:
    Set xRg = Range("C2:C18")
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Or xRg.Areas.Count > 1 Then
        MsgBox " Multiple ranges or columns have been selected ", vbInformation, "Kutools for Excel"
        GoTo lOne
    End If
    xEndRow = xRg.Rows.Count + xRg.Row
    Application.ScreenUpdating = False
    For I = xRg.Rows.Count To 1 Step -1
        If xRg.Cells(I) = "Done" Then
           xRg.Cells(I).EntireRow.Cut
           Rows(xEndRow).Insert Shift:=xlDown
        End If
    Next
    Application.ScreenUpdating = True
End Sub
網站主持人對此評論進行了最小化
嗨水晶,

感謝您提供所有出色的代碼。 沒有 Kutools 有沒有辦法做到這一點? 我也沒有看到選擇單元格範圍的對話框,它沒有為我彈出。

謝謝你,
賈茲
5中的5評分
網站主持人對此評論進行了最小化
嗨,爵士,
您可以直接在代碼中指定單元格範圍,而無需彈出 Kutools 對話框來選擇範圍。
在代碼中,請替換以下行:
Set xRg = Application.InputBox("Select range:", "Kutools for Excel", xTxt, , , , , 8)

使用:
Set xRg = Range("C2:C13")
網站主持人對此評論進行了最小化
當輸入的狀態發生變化時,有沒有辦法將行移回原來的位置? 例如,如果有人將其從“完成”更改為“未完成”,是否有辦法對 excel 進行編程以將其移回?
另外,這種變化是永久性的嗎? 我注意到第一次工作後,它就停止工作了。

感謝您的幫助和發帖!
4.5中的5評分
網站主持人對此評論進行了最小化
嗨佐伊,

感謝您的評論。
1. 對於第一個問題:
被移動的行不能移回原來的位置;
2. 對於第二個問題:
每次需要移動行時都需要手動運行此 VBA 代碼。 如果你想在單元格值符合條件時自動移動行,你可以試試下面的VBA代碼。
筆記:您需要將此代碼放入工作表(代碼)編輯器中(右鍵單擊工作表選項卡並選擇查看代碼以打開編輯器)。 並將列範圍 B2:B12 更改為您自己的範圍。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated Extendoffice 20230111
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xEndRow As Long
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
lOne:
    Set xRg = Range("B2:B12")
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Or xRg.Areas.Count > 1 Then
        MsgBox " Multiple ranges or columns have been selected ", vbInformation, "Kutools for Excel"
        GoTo lOne
    End If
    xEndRow = xRg.Rows.Count + xRg.Row
    Application.ScreenUpdating = False
    For I = xRg.Rows.Count To 1 Step -1
        If xRg.Cells(I) = "Done" Then
           xRg.Cells(I).EntireRow.Cut
           Rows(xEndRow).Insert Shift:=xlDown
        End If
    Next
    Application.ScreenUpdating = True

End Sub
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護