將滿足條件的excel數(shù)據(jù)分別復(fù)制到其他多個(gè)工作表中

將滿足條件的excel數(shù)據(jù)分別復(fù)制到其他多個(gè)工作表中

以前也經(jīng)常遇到類似問題，并且其解決技巧很有效率，因此在這里和大家分享。

如下所示的工作表，在主工作表MASTER中存放著從數(shù)據(jù)庫(kù)下載的全部數(shù)據(jù)。現(xiàn)在，要根據(jù)列E中的數(shù)據(jù)將前12列的數(shù)據(jù)分別復(fù)制到其他工作表中，其中，列E中數(shù)據(jù)開頭兩位數(shù)字是61的單元格所在行前12列數(shù)據(jù)復(fù)制到工作表61中，開頭數(shù)字是62的單元格所在行前12列數(shù)據(jù)復(fù)制到工作表62中，同樣，開頭數(shù)字是63的復(fù)制到工作表63中，開頭數(shù)字是64或65的復(fù)制到工作表64_65中，開頭數(shù)字是68的復(fù)制到工作表68中。

用來完成上述工作的VBA代碼如下：

Sub MasterDataToSheets()

Dim x

Dim i As Long

Dim ii As Long

Dim i61 As Integer

Dim i62 As Integer

Dim i63 As Integer

Dim i6465 As Integer

Dim i68 As Integer

‘選擇前12列數(shù)據(jù)并賦給數(shù)組

x = Sheet1.Cells(1).CurrentRegion.Resize(,12)

‘重新定義數(shù)組大小

ReDim Data61(1 To UBound(x, 1), 1 To 12)

ReDim Data62(1 To UBound(x, 1), 1 To 12)

ReDim Data63(1 To UBound(x, 1), 1 To 12)

ReDim Data6465(1 To UBound(x, 1), 1 To 12)

ReDim Data68(1 To UBound(x, 1), 1 To 12)

‘遍歷數(shù)據(jù)并將第5列符合條件的數(shù)據(jù)存儲(chǔ)到相應(yīng)的數(shù)組中

For i = 2 To UBound(x, 1)

Select Case Left(x(i, 5), 2)

Case 61

i61 = i61 + 1

For ii = 1 To 12

Data61(i61, ii) = x(i, ii)

Next

Case 62

i62 = i62 + 1

For ii = 1 To 12

Data62(i62, ii) = x(i, ii)

Next

Case 63

i63 = i63 + 1

For ii = 1 To 12

Data63(i63, ii) = x(i, ii)

Next

Case 64, 65

i6465 = i6465 + 1

For ii = 1 To 12

Data6465(i6465, ii) = x(i,ii)

Next

Case 68

i68 = i68 + 1

For ii = 1 To 12

Data68(i68, ii) = x(i, ii)

Next

End Select

Next

‘關(guān)閉屏幕更新

Application.ScreenUpdating = False

‘更新工作表61中的數(shù)據(jù)

WithSheets(“61”).Cells(1).CurrentRegion

‘清除原有內(nèi)容，標(biāo)題行除外

.Offset(1).Resize(.Rows.Count,12).ClearContents

‘從單元格A2開始輸入數(shù)據(jù)

.Parent.[A2].Resize(UBound(Data61, 1),12) = Data61

End With

‘更新工作表62中的數(shù)據(jù)

WithSheets(“62”).Cells(1).CurrentRegion

.Offset(1).Resize(.Rows.Count, 12).ClearContents

.Parent.[A2].Resize(UBound(Data62, 1),12) = Data62

End With

‘更新工作表63中的數(shù)據(jù)

WithSheets(“63”).Cells(1).CurrentRegion

.Offset(1).Resize(.Rows.Count,12).ClearContents

.Parent.[A2].Resize(UBound(Data63, 1), 12)= Data63

End With

‘更新工作表64、65中的數(shù)據(jù)

WithSheets(“64_65”).Cells(1).CurrentRegion

.Offset(1).Resize(.Rows.Count,12).ClearContents

.Parent.[A2].Resize(UBound(Data6465,1), 12) = Data6465

End With

‘更新工作表68中的數(shù)據(jù)

WithSheets(“68”).Cells(1).CurrentRegion

.Offset(1).Resize(.Rows.Count,12).ClearContents

.Parent.[A2].Resize(UBound(Data68, 1),12) = Data68

End With

‘開啟屏幕更新

Application.ScreenUpdating = True

‘提示用戶更新數(shù)據(jù)已完成

MsgBox “所有工作表都已更新!”, 64, “已完成”

End Sub

運(yùn)行代碼后，工作表61中的數(shù)據(jù)如下所示。

代碼并不難，很實(shí)用！在代碼中，我已經(jīng)給出了一些注釋，有助于對(duì)代碼的理解。個(gè)人覺得，這段代碼的優(yōu)點(diǎn)在于：

將數(shù)據(jù)存儲(chǔ)在數(shù)組中，并從數(shù)組中取出相應(yīng)的數(shù)據(jù)。

將數(shù)組數(shù)據(jù)直接輸入到工作表單元格，提高了代碼的簡(jiǎn)潔性和效率。

將代碼適當(dāng)修改，可以方便地實(shí)現(xiàn)類似的需求。

版權(quán)聲明：本文內(nèi)容由網(wǎng)絡(luò)用戶投稿，版權(quán)歸原作者所有，本站不擁有其著作權(quán)，亦不承擔(dān)相應(yīng)法律責(zé)任。如果您發(fā)現(xiàn)本站中有涉嫌抄襲或描述失實(shí)的內(nèi)容，請(qǐng)聯(lián)系我們jiasou666@gmail.com 處理，核實(shí)后本網(wǎng)站將在24小時(shí)內(nèi)刪除侵權(quán)內(nèi)容。

版權(quán)聲明：本文內(nèi)容由網(wǎng)絡(luò)用戶投稿，版權(quán)歸原作者所有，本站不擁有其著作權(quán)，亦不承擔(dān)相應(yīng)法律責(zé)任。如果您發(fā)現(xiàn)本站中有涉嫌抄襲或描述失實(shí)的內(nèi)容，請(qǐng)聯(lián)系我們jiasou666@gmail.com 處理，核實(shí)后本網(wǎng)站將在24小時(shí)內(nèi)刪除侵權(quán)內(nèi)容。