回複:哎~累哦~洗洗睡了~~~

來源: JWS 2010-06-02 18:33:28 [] [博客] [舊帖] [給我悄悄話] 本文已被閱讀: 次 (4630 bytes)
Dim sheet1_name As String
Dim sheet1_start_pos_row As Integer
Dim sheet1_start_pos_col As Integer
Dim sheet1_copy_col_count As Integer

Dim sheet2_name As String
Dim sheet2_start_pos_row As Integer
Dim sheet2_start_pos_col As Integer
Dim sheet2_copy_col_count As Integer

Dim des_sheet_name As String


sheet1_name = Sheets("Sheet3").Range("B4").Value
sheet1_start_pos_col = Sheets("Sheet3").Range("C4").Value
sheet1_start_pos_row = Sheets("Sheet3").Range("D4").Value
sheet1_copy_col_count = Sheets("Sheet3").Range("E4").Value

sheet2_name = Sheets("Sheet3").Range("B8").Value
sheet2_start_pos_col = Sheets("Sheet3").Range("C8").Value
sheet2_start_pos_row = Sheets("Sheet3").Range("D8").Value
sheet2_copy_col_count = Sheets("Sheet3").Range("E8").Value

des_sheet_name = Sheets("Sheet3").Range("B12").Value

'clear
Sheets(des_sheet_name).Select
Cells.Select
Selection.ClearContents


Dim current_row As Integer
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Dim sheet3 As Worksheet
Dim temp_result As Integer
Dim sheet2_loop As Integer
Dim first As Boolean
Dim des_current_row As Integer


sheet2_loop = sheet2_start_pos_row
current_row = sheet1_start_pos_row
Set sheet1 = Worksheets(sheet1_name)
Set sheet2 = Worksheets(sheet2_name)
Set sheet3 = Worksheets(des_sheet_name)

' Sheet1 copy title row

Sheets(sheet1_name).Select
Range(Cells(sheet1_start_pos_row - 1, sheet1_start_pos_col), _
Cells(sheet1_start_pos_row - 1, CInt(sheet1_start_pos_col) + CInt(sheet1_copy_col_count))).Select
Selection.Copy
Sheets(des_sheet_name).Select
sheet3.Cells(current_row - 1, 1).Select
ActiveSheet.Paste

Sheets(sheet2_name).Select
Range(Cells(sheet2_start_pos_row - 1, sheet2_start_pos_col), _
Cells(sheet2_start_pos_row - 1, CInt(sheet2_start_pos_col) + CInt(sheet2_copy_col_count))).Select
Selection.Copy
Sheets(des_sheet_name).Select
sheet3.Cells(current_row - 1, 2 + CInt(sheet1_copy_col_count)).Select
ActiveSheet.Paste

des_current_row = current_row

While Sheets(sheet1_name).Cells(current_row, sheet1_start_pos_col).Value <> ""
' Sheet1 copy key row
sheet1.Select
sheet1.Range(Cells(current_row, sheet1_start_pos_col), _
Cells(current_row, CInt(sheet1_start_pos_col) + CInt(sheet1_copy_col_count))).Select
Selection.Copy
sheet3.Select
sheet3.Cells(des_current_row, 1).Select
ActiveSheet.Paste
first = True
sheet2_loop = sheet2_start_pos_row
'sheet2 loop, ->copy
Do While sheet2_loop < 10000
If sheet2.Cells(sheet2_loop, sheet2_start_pos_col) = "" Then
Exit Do
ElseIf sheet2.Cells(sheet2_loop, sheet2_start_pos_col) = Sheets(sheet1_name).Cells(current_row, sheet1_start_pos_col).Value Then


If first Then
first = False

Else
' Sheet1 copy key row
des_current_row = des_current_row + 1
sheet1.Select
sheet1.Range(Cells(current_row, sheet1_start_pos_col), _
Cells(current_row, CInt(sheet1_start_pos_col) + CInt(sheet1_copy_col_count))).Select
Selection.Copy
sheet3.Select
sheet3.Cells(des_current_row, 1).Select
ActiveSheet.Paste
End If

sheet2.Select
sheet2.Range(Cells(sheet2_loop, sheet2_start_pos_col), _
Cells(sheet2_loop, CInt(sheet2_start_pos_col) + CInt(sheet2_copy_col_count))).Select
Selection.Copy
sheet3.Select
sheet3.Cells(des_current_row, 2 + CInt(sheet1_copy_col_count)).Select
ActiveSheet.Paste
End If
sheet2_loop = sheet2_loop + 1
Loop
des_current_row = des_current_row + 1
current_row = current_row + 1
Wend
請您先登陸,再發跟帖!

發現Adblock插件

如要繼續瀏覽
請支持本站 請務必在本站關閉/移除任何Adblock

關閉Adblock後 請點擊

請參考如何關閉Adblock/Adblock plus

安裝Adblock plus用戶請點擊瀏覽器圖標
選擇“Disable on www.wenxuecity.com”

安裝Adblock用戶請點擊圖標
選擇“don't run on pages on this domain”