麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] ~ 發現一個新的問題關於IF判斷式 [打印本頁]

作者: willy1205 時間: 2014-3-31 16:19 標題: 如何用VBA將資料中不要的空白列刪除，而將資料整合呢??

最近面臨到問題是資料已經篩選好了，因為將不要的資料整列刪除，只留下要的資料，導致資料之間有空格存在，
EX:
   A    B    C D E .....
1  甲 10 20
2
3 丙 30 50
4
5 丁  60 80
因為資料很多，有辦法使用VBA將資料整合成以下這樣嗎??? 謝謝大家
  A    B    C D E .....
1  甲 10 20
2  丙 30 50
3  丁  60 80
4
5

作者: f3202 時間: 2014-3-31 18:45

http://support.microsoft.com/kb/2679461/zh-tw

作者: GBKEE 時間: 2014-3-31 19:50

回復 1# willy1205

Sub Ex()
Range("A:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'SpecialCells 特殊目標
'xlCellTypeBlanks 空格
'EntireRow 整個列
End Sub

複製代碼

作者: willy1205 時間: 2014-4-1 10:40

回復 3# GBKEE

謝謝大大!!
work very well!

作者: willy1205 時間: 2014-4-1 13:23

回復 3# GBKEE

再請問大大一個問題，我再指定按鈕巨集的時候出現錯誤：

formula is too complex to be assigned to object

這個原因是為什麼??之前都好好的怎麼今天要多寫幾個按鈕就出錯了，該怎麼解決??

作者: GBKEE 時間: 2014-4-1 15:23

回復 5# willy1205

formula is too complex to be assigned to object
公式太複雜要分配給對象

按鈕刪除,存檔後關閉Excel,開啟檔案設按鈕試試看

作者: willy1205 時間: 2014-4-1 17:37

回復 6# GBKEE

喔喔 OK

在問一下如果我的資料上面第一行是有文字的並且需要保留下來
EX :
         A       B    C .. ..
1    人名  金錢性別
2       甲    100    M
這樣的話我再範圍那邊要做什麼修改呢?? Range("A:C").

謝謝

作者: GBKEE 時間: 2014-4-1 20:07

回復 7# willy1205

Option Explicit
Sub Ex()
Dim R As Long
R = Range("A" & Rows.Count).End(xlUp).Row 'A欄由最後一列往上到有資料的列號
Range("A2:C" & R).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'SpecialCells 特殊目標
'xlCellTypeBlanks 空格
'EntireRow 整個列
End Sub

複製代碼

作者: lp986749 時間: 2014-4-1 21:22

如果是下列情況時
            A       B       C
1          01       03    04

2                      05

3          06       07    08

4

5       09       10    11
第二列無法刪除用何種方式設定?

作者: GBKEE 時間: 2014-4-2 07:10

回復 9# lp986749

Option Explicit
Sub Ex() '.SpecialCells(xlCellTypeBlanks).EntireRow 如 9# 的重疊區域程式無法刪除
With Range("A:C")
' MsgBox .SpecialCells(xlCellTypeBlanks).EntireRow.Address
'A2,C2 會有重疊區域 $2:$2,$2:$2,$4:$4
Intersect(.Cells, .SpecialCells(xlCellTypeBlanks).EntireRow).Delete xlUp
'Intersect 方法傳回 Range 物件，此物件代表兩個或多個範圍重疊的矩形範圍。
'整合為不重疊的區域,程式即可刪除
End With
'SpecialCells 特殊目標
'xlCellTypeBlanks 空格
'EntireRow 整個列
End Sub

複製代碼

作者: willy1205 時間: 2014-4-2 12:53

謝謝版主，再請問一下
我今天有個檔案我開了50個sheet,每個sheet我都設了一個按鈕用為導入資料至sheet1 ,
但今天我要整理sheet1的資料我想再寫個按鈕使用版主給我的巨集整合資料，
可是出現""公式太複雜要分配給對象""
這樣我該怎麼刪除按鈕存檔重新開啟檔案呢??

作者: GBKEE 時間: 2014-4-2 13:13

回復 11# willy1205
我使用的2003版沒這問題

作者: lp986749 時間: 2014-4-2 14:39

謝謝您的解答!感恩啦!

作者: willy1205 時間: 2014-4-7 11:48

回復 12# GBKEE

版主在請問一下如果今天我資料只到A43, 不是由A欄最後一列往上算，這樣range這邊該如何修改??

R = Range("A" & Rows.Count).End(xlUp).Row 'A欄由最後一列往上到有資料的列號

作者: GBKEE 時間: 2014-4-7 12:13

回復 14# willy1205
如果今天我資料只到A43,是何情況沒說清楚,要附檔看看.

作者: willy1205 時間: 2014-4-7 12:25

回復 15# GBKEE

[attach]17949[/attach]

如附檔，裡面一個表格，最下面簽名用，所以資料只會到A37 ，有辦法在不影響表格大小之下刪除中間資料與資料中間沒有的空格列嗎??

作者: GBKEE 時間: 2014-4-7 13:47

回復 16# willy1205

Option Explicit
Sub Ex_排序() '不必刪除
With Range("A3:G37")
.Sort .Cells(1), xlAscending
End With
End Sub

複製代碼

作者: willy1205 時間: 2014-4-7 14:17

回復 17# GBKEE

謝謝版主
真是受益良多

作者: willy1205 時間: 2014-4-11 12:26

回復 19# willy1205

[attach]17978[/attach]

如附檔，再sheet1輸入資料，按下按鈕導入資料至甲君及乙君的表裡面，
但是目前除了甲君乙君以外，總共有35個人，一個人有2個可能主辦或協辦，
所以光一個導入資料的按鈕就有70個if判斷式.....
不知道一個巨集是否擠得下70個if的判斷式嗎??
還是有其他可以簡化的寫法呢??

謝謝版主

作者: GBKEE 時間: 2014-4-11 13:14

回復 20# willy1205
所以光一個導入資料的按鈕就有70個if判斷式?
要判斷什麼,沒在檔案中說明.

作者: willy1205 時間: 2014-4-11 14:34

本帖最後由 willy1205 於 2014-4-11 14:36 編輯

回復 20# GBKEE

剛好像沒存好巨集再放一次[attach]17980[/attach]
怕又沒存好我把巨集複製再筆記本

是的，判斷主辦或協辦的名子是哪個就把資料導入到那個人的sheet裡面，
我是寫If Worksheets("sheet1").Range("B8").Value = "甲君" Then 利用儲存格上的名子判斷輸入的資料該去甲君的sheet還是其他人的
所以有70個判斷式...

作者: GBKEE 時間: 2014-4-11 15:26

本帖最後由 GBKEE 於 2014-4-11 16:40 編輯

回復 21# willy1205

所以有70個判斷式...

不需如此麻煩

Sub RoundedRectangle1_Click()
Dim NewRow As Integer, E As Range, Sh As Worksheet
Set Sh = Worksheets("Sheet1") '變數指定為工作表 **下面的程式碼如有更改工作表 **改這變數可省麻煩
NewRow = Sh.Range("J34").Value
' Worksheets("sheet1").Range("B8").Value '管他是甲君,乙君,丙君只要這工作表(名稱)有在活頁簿中,
For Each E In Sh.Range("B8,B10") '導入B8,B10 的儲存格
With Worksheets(E.Value) 'E.Value 的工作表
.Cells(NewRow, 1) = Sh.Range("C5")
.Cells(NewRow, 2) = Sh.Range("C6").Value
.Cells(NewRow, 3) = Sh.Range("I12").Value
.Cells(NewRow, 4) = Sh.Range("I13").Value
.Cells(NewRow, 6) = Sh.Range("G22").Value
If E.Address = "$B$8" Then '主辦
.Cells(NewRow, 7) = Sh.Range("H30")
Sh.Range("J34") = NewRow
Else '協辦
.Cells(NewRow, 7) = Sh.Range("H32")
Sh.Range("J35") = NewRow
End If
End With
Next
MsgBox "New Data added", vbOKOnly, "Data"
End Sub

複製代碼

作者: willy1205 時間: 2014-4-11 15:30

回復 22# GBKEE

謝謝版主，我再試試看

還有如果初學者想找書自修VBA的話有推薦的嗎??
目前都只是網路找PDF書籍自己慢慢摸...有點難懂

作者: GBKEE 時間: 2014-4-11 15:37

回復 23# willy1205
多看看程式區回覆的程式碼,不懂的複製下來,看看vba 視窗的說明.
再不明瞭,可發問,光看書不如無書

作者: willy1205 時間: 2014-4-11 15:39

回復 24# GBKEE

okok 謝謝版主

作者: opelwang 時間: 2014-4-11 16:14

恛噎BA的用法.

作者: willy1205 時間: 2014-4-11 16:15

回復 22# GBKEE

版主有個問題，就是乙君是協辦，所以乙君抓的金額應該是H32，只有這個會跟甲君不同，我自己剛也沒發現到，
由於他是協辦所以他的資料要在第27行開始，但我按了導入資料以後J35變成7，所以乙君資料也出現在第7行，
這要怎麼修改才可以??

作者: willy1205 時間: 2014-4-11 16:49

回復 22# GBKEE

謝謝版主資料抓取沒錯，可是J35還是變成7，乙君的資料還是出現在第7行而不是第27行耶

作者: GBKEE 時間: 2014-4-11 17:25

回復 28# willy1205

Option Explicit
Sub RoundedRectangle1_Click()
Dim NewRow As Integer, E As Range, Sh As Worksheet
Set Sh = Worksheets("Sheet1") '變數指定為工作表 **下面的程式碼如有更改工作表 **改這變數可省麻煩
'Worksheets("sheet1").Range("B8").Value '管他是甲君,乙君,丙君只要這工作表(名稱)有在活頁簿中,
For Each E In Sh.Range("B8,B10") '導入B8,B10 的儲存格
'判斷主辦,協辦的列號
If E.Address = "$B$8" Then '主辦
NewRow = Sh.Range("J34").Value
Else '協辦
NewRow = Sh.Range("J35").Value
End If
With Worksheets(E.Value) 'E.Value 的工作表
.Cells(NewRow, 1) = Sh.Range("C5")
.Cells(NewRow, 2) = Sh.Range("C6").Value
.Cells(NewRow, 3) = Sh.Range("I12").Value
.Cells(NewRow, 4) = Sh.Range("I13").Value
.Cells(NewRow, 6) = Sh.Range("G22").Value
'判斷主辦,協辦要改變的位置列號
If E.Address = "$B$8" Then '主辦
.Cells(NewRow, 7) = Sh.Range("H30")
Else '協辦
.Cells(NewRow, 7) = Sh.Range("H32")
End If
End With
Next
MsgBox "New Data added", vbOKOnly, "Data"
End Sub

複製代碼

作者: willy1205 時間: 2014-4-11 17:28

回復 29# GBKEE

了解謝謝版主

作者: opelwang 時間: 2014-4-14 12:20

回復 26# opelwang

應該是打錯字了, 正確是:

學習VBA的用法.

作者: willy1205 時間: 2014-5-13 12:20

回復 29# GBKEE

版主我最近重新練習又發現了一個問題，就是如果我想要多判斷C10 與 C12 ,也就是同時可能兩個主辦兩個協辦，
能在'For Each E In Sh.Range("B10,B12")' 這邊直接插入'For Each E In Sh.Range("B10,B12,C10,C12") 嗎??'
那我在下面IF判斷式該如何修改??
顯示的位子都不變只是多判斷儲存格C10與C12

作者: willy1205 時間: 2014-5-13 17:35

回復 32# willy1205

試了一下好像沒辦法直接加入C10 C12,且下面判斷式會卡死...

作者: willy1205 時間: 2014-5-16 15:03

版主有方法可以解決嗎!?

作者: willy1205 時間: 2014-5-19 16:31 標題: ~ 發現一個新的問題關於IF判斷式

本帖最後由 GBKEE 於 2014-5-22 16:40 編輯

我最近又重新將程式拿出來練習，原本判斷式是判斷B10與B12，
我發現如果今天我想要多判斷C10與C12，甚至D10與D12，不知道該從哪邊插入IF判斷式，
For Each E In Sh.Range("B8,B10") 這邊好像沒辦法直接改成 For Each E In Sh.Range("B8,B10,C10,C12")
有辦法能多判斷C10與C12嗎??

付上原帖的連結 http://forum.twbts.com/viewthrea ... p;extra=&page=3
版主給的程式碼
Dim NewRow As Integer, E As Range, Sh As Worksheet
Set Sh = Worksheets("4-工作日誌OP COA AGR")
For Each E In Sh.Range("B10,B12")
If E.Address = "$B$10" Then
         NewRow = Sh.Range("J34").Value
      Else
         NewRow = Sh.Range("J35").Value
      End If

With Worksheets(E.Value)

.Cells(NewRow, 1) = Sh.Range("C7")

.Cells(NewRow, 2) = Sh.Range("C8").Value

.Cells(NewRow, 3) = Sh.Range("I14").Value

.Cells(NewRow, 4) = Sh.Range("I15").Value

.Cells(NewRow, 6) = Sh.Range("G24").Value

If E.Address = "$B$10" Then

.Cells(NewRow, 7) = Sh.Range("H32")
.Cells(NewRow, 5) = Sh.Range("J10").Value

Sh.Range("J34") = NewRow

Else

.Cells(NewRow, 7) = Sh.Range("H34")
.Cells(NewRow, 5) = Sh.Range("J12").Value

Sh.Range("J35") = NewRow

End If

End With

Next
MsgBox "New Data added", vbOKOnly, "Data"

End Sub

作者: GBKEE 時間: 2014-5-21 15:29

回復 35# willy1205

Sub Ex()
Dim E, NewRow
For Each E In Range("B8,B10,C10,C12")
Select Case E.Address(0, 0)
Case "B8"
NewRow = 1
Case "B10"
NewRow = 2
Case "C10"
NewRow = 3
Case "C12"
NewRow = 4
End Select
MsgBox NewRow
Next
End Sub
Sub Ex1()
Dim E, NewRow
For Each E In Range("B8,B10,C10,C12")
If E.Address(0, 0) = "B8" Then
NewRow = 1
ElseIf E.Address(0, 0) = "B10" Then
NewRow = 2
ElseIf E.Address(0, 0) = "C10" Then
NewRow = 3
ElseIf E.Address(0, 0) = "C12" Then
NewRow = 4
End If
MsgBox NewRow
Next
End Sub

複製代碼

作者: willy1205 時間: 2014-5-21 16:58

回復 36# GBKEE

版主謝謝你，請問如果要把他寫在同一個按鈕巨集裡面這有辦法嗎??

作者: willy1205 時間: 2014-5-21 17:14

如果將原本的
For Each E In Sh.Range("B10,B12")
If E.Address = "$B$10" Then
         NewRow = Sh.Range("J34").Value
      Else
         NewRow = Sh.Range("J35").Value
      End If
改成
For Each E In Range("B10,B12,C10,C12")
Select Case E.Address(0, 0)
Case "B10"
      NewRow = 1
Case "B12"
      NewRow = 2
Case "C10"
      NewRow = 3
Case "C12"
NewRow = 4
End Select
下面的With Worksheets(E.Value)會變成out of range

該如何修改?

作者: willy1205 時間: 2014-5-22 17:32

回復 38# willy1205

[attach]18343[/attach]

如練習這個檔案，原本是判斷B10與B12(A君與B君)然後按下按鈕匯入資料進去A君與B君的SHEET，
現在想在C10與C12，D10與D12分別加入C君 D君 F君 E君的話，該怎麼插入進去判斷式呢??

作者: willy1205 時間: 2014-5-28 10:25

回復 39# willy1205

請問版主有建議嗎?? 謝謝

作者: GBKEE 時間: 2014-5-28 14:54

回復 40# willy1205
你回復的是willy1205 我沒查看到

Sub Allowance報銷單_RoundedRectangle2_Click()
Dim NewRow As Integer, E As Range, Sh As Worksheet
Set Sh = Worksheets("4-工作日誌OP COA AGR")
For Each E In Range("B10,B12,C10,C12")
If E <> "" Then '
Select Case E.Address(0, 0)
Case "B10"
NewRow = 1
Case "B12"
NewRow = 2
Case "C10"
NewRow = 3
Case "C12"
NewRow = 4
End Select
With Worksheets(E.Value)
'E = "" 或沒這工作表-> out of range 陣列索引超出範圍 (錯誤 9)
.Cells(NewRow, 1) = Sh.Range("C7")
.Cells(NewRow, 2) = Sh.Range("C8").Value
.Cells(NewRow, 3) = Sh.Range("I14").Value
.Cells(NewRow, 4) = Sh.Range("I15").Value
.Cells(NewRow, 6) = Sh.Range("G24").Value
If E.Address = "$B$10" Then
.Cells(NewRow, 7) = Sh.Range("H32")
.Cells(NewRow, 5) = Sh.Range("J10").Value
Sh.Range("J34") = NewRow
Else
.Cells(NewRow, 7) = Sh.Range("H34")
.Cells(NewRow, 5) = Sh.Range("J12").Value
Sh.Range("J35") = NewRow
End If
End With
End If
Next
MsgBox "New Data added", vbOKOnly, "Data"
End Sub

複製代碼

作者: willy1205 時間: 2014-5-30 11:43

回復 41# GBKEE

可是版主只有在上面For Each E In Range("B10,B12,C10,C12")這邊加入C10與C12下面才會OUT OF RANGE,
原本只有B10與B12的話是沒問題的，
那如果上面加入C10與C12，下面的If E.Address = "$B$10" Then 這邊要怎麼加入C10進入判斷式???

就是B10與C10他們導出的結果是一樣，然後B12與C12導出的結果一樣。

P.S. 因為原本的程式只判斷B10與B12，想再加入C10與C12，讓B10與C10一組，B12與C12一組。

作者: GBKEE 時間: 2014-5-31 20:25

回復 42# willy1205

就是B10與C10他們導出的結果是一樣，然後B12與C12導出的結果一樣

你要的導出的結果,請附檔看看.猜不出你要的是什麼!!是這樣嗎?

Sub Allowance報銷單_RoundedRectangle2_Click()
Dim NewRow As Integer, E As Range, Sh As Worksheet
Set Sh = Worksheets("4-工作日誌OP COA AGR")
For Each E In Range("B10,B12")
If E <> "" Then
Set Sh = Sheets(E.Value)
Else
Set Sh = Sheets(E.Offset(, 1).Value)
End If
If E.Address(0, 0) = "B10" Then NewRow = 1
If E.Address(0, 0) = "B12" Then NewRow = 2
With Sh
.Cells(NewRow, 1) = .Range("C7")
.Cells(NewRow, 2) = .Range("C8").Value
.Cells(NewRow, 3) = .Range("I14").Value
.Cells(NewRow, 4) = .Range("I15").Value
.Cells(NewRow, 6) = .Range("G24").Value
If E.Address = "$B$10" Then
.Cells(NewRow, 7) = .Range("H32")
.Cells(NewRow, 5) = .Range("J10").Value
.Range("J34") = NewRow
Else
.Cells(NewRow, 7) = .Range("H34")
.Cells(NewRow, 5) = .Range("J12").Value
.Range("J35") = NewRow
End If
End With
End If
Next
MsgBox "New Data added", vbOKOnly, "Data"
End Sub

複製代碼

作者: willy1205 時間: 2014-6-5 10:44

回復 43# GBKEE

版主~就像這個檔案裡面一樣，原本只有A君與B君，我想新增輸出結果到C君與D君
然後A君與C君都是主辦所以輸出相同數字，C君與D君都是協辦輸出相同數字，
我在檔案裡面標是紅色的地方就是新增的部份
[attach]18437[/attach]

作者: GBKEE 時間: 2014-6-5 13:30

回復 44# willy1205
試試看

Sub Allowance報銷單_RoundedRectangle2_Click()
Dim NewRow As Integer, E As Range, Sh As Worksheet
Dim Rng(1 To 2) As Range, i As Integer
Set Sh = Worksheets("4-工作日誌OP COA AGR")
With Sh
Set Rng(1) = .Range("b10:F10") '主辦者的儲存格範圍
Set Rng(2) = .Range("b12:F12") '協辦者的儲存格範圍
End With
For i = 1 To 2
NewRow = Sh.Range("J34").Value
If i = 2 Then NewRow = Sh.Range("J35").Value
For Each E In Rng(i)
If E <> "" Then
With Worksheets(E.Value)
.Cells(NewRow, 1) = Sh.Range("C7")
.Cells(NewRow, 2) = Sh.Range("C8").Value
.Cells(NewRow, 3) = Sh.Range("I14").Value
.Cells(NewRow, 4) = Sh.Range("I15").Value
.Cells(NewRow, 6) = Sh.Range("G24").Value
If i = 1 Then
.Cells(NewRow, 7) = Sh.Range("H32")
.Cells(NewRow, 5) = Sh.Range("J10").Value
Sh.Range("J34") = NewRow
Else
.Cells(NewRow, 7) = Sh.Range("H34")
.Cells(NewRow, 5) = Sh.Range("J12").Value
Sh.Range("J35") = NewRow
End If
End With
End If
Next
Next
MsgBox "New Data added", vbOKOnly, "Data"
End Sub

複製代碼

作者: willy1205 時間: 2014-6-5 13:40

回復 45# GBKEE

yes 謝謝版主我在試試看~

作者: willy1205 時間: 2014-7-10 15:46

回復 45# GBKEE

版主在程式第四行那邊Set Sh = Worksheets("4-工作日誌OP COA AGR")，假設今天我想要開50個工作日誌sheet，即4-工作日誌OP COA AGR , 4-工作日誌OP COA AGR(2)........~ 4-工作日誌OP COA AGR(50)，
但我如果是複製工作表的話，變成每個巨集設定sh那邊都是Set Sh = Worksheets("4-工作日誌OP COA AGR")，這樣就變成除了4-工作日誌OP COA AGR這個工作表可以正常運作以外其他49個都無法，
因為sh被卡死在Worksheets("4-工作日誌OP COA AGR")了，這種情況的話該怎麼改??

作者: willy1205 時間: 2014-7-10 15:53

回復 GBKEE

版主在程式第四行那邊Set Sh = Worksheets("4-工作日誌OP COA AGR")，假設今天我想要 ...
willy1205 發表於 2014-7-10 15:46

我試了下是不是將名稱改成Activesheet.name ??

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