請問SHEET轉換紀錄的問題

tonycho33

1.請問一下,如何將A SHEET存到B SHEET當J欄有出現任何值時對應的該列就會複製到B SHEET(空白處延伸)中


2.另一種是當按下按鈕時(對應工單號碼),則該工單對應的所有列就複製到B SHEET空白處

B SHEET要一直累加,不能留空白
謝謝

tonycho33

回復 14# register313


    感謝協助,這樣的做法的確比我想得還好很多
  感謝

register313

回復 13# tonycho33

    a按鈕(aa->bb)拿掉 b按鈕(bb->cc)拿掉  (不能自己用按鈕控制)
=> 當aa工作表T欄新增1個"已排程"時,自動新增到bb工作表及cc工作表
   
Book1.rar (29.93 KB)

下載次數: 13

2012-2-16 18:04

tonycho33

回復 12# GBKEE
回復 11# register313
F欄是資料欄,隱藏錯了
E欄是預留欄位

請教一下
之前詢問過的問題要彙整
aa→bb 是當T欄輸入『已排程』則匯入bb,並可以一筆一筆新增,已ok
bb→cc 目前是只能欄位轉換,可否當bb有新增時,cc也可以一筆一筆新增,請協助
就是當aa新增一筆T欄輸入『已排程』,該筆3列會轉入bb最後3列,之後轉換到cc時,只轉這一筆,不會全部一起轉換,並排在最下方
cc→dd 則是之前提問的功能,可以一筆一筆新增dd,已ok


所以麻煩第二項功能可以協助
謝謝

GBKEE

回復 10# tonycho33
請問 如圖

下載 (32.19 KB)

2012-2-16 12:58

register313

回復 10# tonycho33

1. Sub QQ()
   
2. BR = 2
   
3. With Sheets("aa")
   
4.   For AR = 3 To [A65536].End(xlUp).Row Step 3
   
5.     If .Cells(AR, "T") = "已排程" Then
   
6.        .Cells(AR, "A").Resize(3, 19).Copy Sheets("bb").Cells(BR, "A")
   
7.        BR = BR + 3
   
8.     End If
   
9.   Next AR
   
10. End With
    
11. End Sub

複製代碼

tonycho33

回復 9# GBKEE


    麻煩謝謝

GBKEE

回復 8# tonycho33
    當T3出現"已排程"時則
SHEETS("AA") T欄中都沒有資料啊

tonycho33

回復 7# GBKEE

不好意思可以在請教一個類似的問題嗎
我想將aa sheet記錄到bb sheet
條件是在aa sheet對應的t 欄有出現值的話
就將對應的A到R欄往下3列複製到bb sheet
但是資料還要保留/不要刪除

例如：當T3出現"已排程"時則A3到R5 三列copy到bb sheet中 空格處
但是A3到R5不要刪除
接下來就以此類推可以仿照這樣記錄

謝謝

GBKEE

回復 5# tonycho33

1. Private Sub Data_Copy(xF As Integer, xCriteria As String)
   
2.     Dim Sh As Worksheet, Rng(1 To 2) As Range, xRow As Range
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.      With Sheet7   'Sheets("A")
   
6.         .AutoFilterMode = False
   
7.         .Range("a1").AutoFilter Field:=xF, Criteria1:=xCriteria
   
8.         Set Rng(1) = .UsedRange.SpecialCells(xlCellTypeVisible)
   
9.         If Application.CountA(Rng(1)) = Rng(1).Columns.Count Then  
   
10.              .AutoFilterMode = False
    
11.             MsgBox IIf(xCriteria <> "<>", "找不到 工單 :" & xCriteria, "完成時間  沒有的資料")
    
12.             GoTo e
    
13.         End If
    
14.         Set Sh = Sheets.Add
    
15.         Rng(1).Copy Sh.[a1]
    
16.         Sh.UsedRange.Offset(1).Copy Sheet6.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    
17.         Sh.Delete
    
18.         .AutoFilterMode = False
    
19.         .Activate
    
20.         For Each xRow In Rng(1).Rows.Cells
    
21.             If xRow.Row <> 1 Then
    
22.                 If Rng(2) Is Nothing Then
    
23.                     Set Rng(2) = xRow
    
24.                 Else
    
25.                     Set Rng(2) = Union(xRow, Rng(2))
    
26.                 End If
    
27.             End If
    
28.         Next
    
29.         Rng(2).Delete xlShiftUp
    
30.     End With
    
31. e:
    
32.     Application.ScreenUpdating = True
    
33.     Application.DisplayAlerts = True
    
34. End Sub

複製代碼