返回列表 上一主題 發帖

[發問] 刪除多餘的表頭

b9208

帖子
182 
主題
34 
精華
0 
積分
316 
點名
0  
作業系統
Win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-5-2 
最後登錄
2023-6-24 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-2-24 22:23 | 只看該作者

[發問] 刪除多餘的表頭

各位先進！
請問如何設計刪除資料中多餘的表頭（如附件黃色區域列數）
僅保留最上面的表頭。

謝謝
W1.rar (4.61 KB)
收藏 分享
100 字節以內
不支持自定義 Discuz! 代碼

oobird
　頭銜: 街友一族

超級版主Rank: 8Rank: 8

帖子
1572 
主題
16 
精華
2 
積分
1521 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
150 
性別
男 
註冊時間
2010-5-1 
最後登錄
2016-1-13 

論壇貢獻勳章
2#
發表於 2011-2-25 11:04 | 只看該作者
樓上代碼簡明流暢，想請教
通常Find方法找多筆會用FindNext方法使代碼更簡潔
此例是否有特殊原因不使用？

TOP

b9208

帖子
182 
主題
34 
精華
0 
積分
316 
點名
0  
作業系統
Win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-5-2 
最後登錄
2023-6-24 
3#
發表於 2011-2-25 11:27 | 只看該作者
回復 4# donald

先進
因表頭五列中，有些欄位有合併儲存格，
執行有問題

個人想法：
依A欄來判斷，由A6開始向下，如儲存格內容包含〞某某公司抬頭〞，則刪除五列列數（含〞某某公司抬頭〞列）
但功力不足，不知是否可行。

謝謝指導
100 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2011-2-25 11:28 | 只看該作者
此例是在大範圍內直接搜尋，並不必指定開始搜尋位置
所以，並不影響搜尋結果，因為C永遠是找到相同值的第一個位置
學海無涯_不恥下問

TOP

b9208

帖子
182 
主題
34 
精華
0 
積分
316 
點名
0  
作業系統
Win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-5-2 
最後登錄
2023-6-24 
5#
發表於 2011-2-25 11:44 | 只看該作者
回復 4# donald

非常抱歉
VBA可以執行
因刪除表頭資料位於 (Sheet2)，程式碼位於(Sheet1)，執行有問題。
將程式碼位於(Sheet2)，則執行OK。

非常感謝
100 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2011-2-25 13:33 | 只看該作者
回復 7# b9208


    With ActiveSheet.UsedRange.Offset(1, 0)
只需改這行，ActiveSheet改成你要刪除的工作表名即可
請確實瞭解程式碼，論壇可不是代工廠
學海無涯_不恥下問

TOP

b9208

帖子
182 
主題
34 
精華
0 
積分
316 
點名
0  
作業系統
Win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-5-2 
最後登錄
2023-6-24 
7#
發表於 2011-2-25 23:10 | 只看該作者
回復 8# Hsieh

按鈕Sheet1於Sheets(“Sheet1”) 中：
修改如下：
With Sheets("WW").UsedRange.Offset(1, 0)
執行有問題（請看附件）

按鈕WW於Sheets(“WW”) 中：
With ActiveSheet.UsedRange.Offset(1, 0)
執行 OK （請看附件）

另加入刪除多餘表頭後，再判斷D欄 = “ “，則刪除該列。
AA = Range("A65536").End(xlUp).Row
    For i = 6 To AA
        If Cells(i, 4) = "" Then
        If myi Is Nothing Then
        Set myi = Cells(i, 4)
        Else
        Set myi = Union(myi, Cells(i, 4))
        End If
        End If
    Next
    If Not myi Is Nothing Then myi.EntireRow.Delete

非常感謝指教

W1-1.rar (121.67 KB)
100 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2011-2-25 23:38 | 只看該作者
回復 9# b9208
  1. Sub deldata_1()
  2. Dim c As Range
  3.   With Sheets("WW").UsedRange.Offset(1, 0)
  4.       Set c = .Find(Sheets("WW").Cells(1, 1), Lookat:=xlWhole)
  5.       If Not c Is Nothing Then
  6.           Do
  7.               c.Resize(5, 15).Delete (2)
  8.               Set c = .Find(Sheets("WW").Cells(1, 1), Lookat:=xlWhole)
  9.            Loop Until c Is Nothing
  10.       Else
  11.             MsgBox "沒有找到"
  12.       End If
  13.    End With
  14. End Sub
複製代碼
學海無涯_不恥下問

TOP

b9208

帖子
182 
主題
34 
精華
0 
積分
316 
點名
0  
作業系統
Win 7 
軟體版本
Office 2010 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-5-2 
最後登錄
2023-6-24 
9#
發表於 2011-2-26 00:45 | 只看該作者
回復 10# Hsieh

謝謝版主指導
執行沒有問題了
100 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題