happycoccolin

¦^´_ 45# stillfish00


    S¤j~~~¥i¥H¦A½Ð±Ð¤@¤U³o¤@¬q¬O¦b´y­z¬Æ»ò°Ê§@¶Ü~

Application.ScreenUpdating = False
  With Workbooks.Open(f)  ³oÀ³¸Ó¬O«ü·s¶}ªº¸ê®ÆÀɶÜ?
    With .Sheets(1)
      ar = .Range("A5:H" & .[A5].CurrentRegion.Rows.Count).Value ³o¥y¤£À´¬Æ»ò·N«ä
    End With
    .Close False
  End With
  Application.ScreenUpdating = True
  
  r = UBound(ar)
  With Workbooks.Add
    With .Sheets(1)
      For i = LBound(cIndexOld) To UBound(cIndexOld)
        .Cells(1, cIndexNew(i)).Resize(r).Value = Application.WorksheetFunction.Index(ar, 0, cIndexOld(i))
        .Cells(1, cIndexNew(i)).Value = arNewHeader(i)
      Next
    End With

happycoccolin

¦^´_ 43# stillfish00


    S¤j~­Y¦³ªºÀɮ׬OB5Äæ¶}©l¦³ªº¬OB6Äæ¶}©l ¥i¥H«ç»ò§PÂ_?

ÁÙ¦³­Y¬O·sªí®æ©Ò¦³Äæ¦ì³£­n¦³TITLE ¥i¥H³£¶ñ¤W¶Ü~

ÁÂÁÂStillfish00¤j¤j!

stillfish00

¦^´_ 44# happycoccolin

1. Sub TEST()
   
2.   Dim ar, r As Long, i As Long
   
3.   Dim cIndexOld, cIndexNew, arNewHeader
   
4.   Dim f
   
5.   
   
6.   cIndexOld = Array(2, 3, 4, 5, 7, 8)   'AÀɮפ¤­n·h°ÊªºÄæ
   
7.   cIndexNew = Array(2, 4, 21, 24, 43, 44)   '·h¨ìBÀɦì¸m(Ä渹)
   
8.   arNewHeader = Array("W", "R", "X", "B", "JJ", "KK") 'BÀɼÐÃD¦WºÙ
   
9.   
   
10.   f = Application.GetOpenFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¿ï¾Ü¨Ó·½ÀÉ®×")
    
11.   If Not TypeName(f) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
    
12.   
    
13.   Application.ScreenUpdating = False
    
14.   With Workbooks.Open(f)
    
15.     With .Sheets(1)
    
16.       ar = .Range("A5:H" & .[A5].CurrentRegion.Rows.Count).Value
    
17.     End With
    
18.     .Close False
    
19.   End With
    
20.   Application.ScreenUpdating = True
    
21.   
    
22.   r = UBound(ar)
    
23.   With Workbooks.Add
    
24.     With .Sheets(1)
    
25.       For i = LBound(cIndexOld) To UBound(cIndexOld)
    
26.         .Cells(1, cIndexNew(i)).Resize(r).Value = Application.WorksheetFunction.Index(ar, 0, cIndexOld(i))
    
27.         .Cells(1, cIndexNew(i)).Value = arNewHeader(i)
    
28.       Next
    
29.     End With
    
30.    
    
31.     If MsgBox("¬O§_­nÀx¦sÀÉ®×?", vbYesNo) = vbYes Then
    
32.       f = Application.GetSaveAsFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¥t¦s¬°·sÀÉ")
    
33.       If Not TypeName(f) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
    
34.       .SaveAs f, FileFormat:=xlWorkbookDefault
    
35.     End If
    
36.   End With
    
37. End Sub

½Æ»s¥N½X

happycoccolin

¦^´_ 43# stillfish00


    S¤j~~~§Ú¦³¥t¶}¤@­Ó´£°Ý~¦b¥H¤U¸ô®|~

http://forum.twbts.com/thread-10164-1-1.html

¦]¬°¥Ø«e»Ý­n±N¤@­ÓÀɮפ¤ ¯S©w´XÄ檺¸ê®Æ¨ú¥X(¤£¥Î¤ñ¹ï) ¨Ã²£¥Í¤@·sÀɮ׶ñ¤J¯S©wÄæ¦ì

¨â­ÓÀɮתºªíÀY¤ÎÄæ¦ì¬O¤£¦Pªº

¦Ó¥B¥Ø«eA.xlsx¬O¤£©T©wªº »Ý­n¥ÑUser¦Û¦æ¿ï¾Ü¸ü¤J

¦³¸ÕµÛ¥Î¤§«eªºÀÉ®×­×§ï ¦ý¬O»yªk¤£¯Â¼ô©|¦b¾Ç²ß¤¤ ©Ò¥H·Q½Ð±ÐS¤j~~~

ÁÂÁÂS¤jªº¦^ÂÐ~~

stillfish00

¦^´_ 42# happycoccolin
¤£©ú¥Õ§Aªº·N«ä¡A
­n³sªíÀY¶K¹L¥h? ½Æ»s®É¤@°_¿ï´N¦n°Õ

¯à§_¤W¶ÇÀɮצA»¡©ú²MÂI?

happycoccolin

¦^´_ 40# stillfish00


    S¤j~¤£¦n·N«ä·Q½Ð±Ð¤@¤U~¦p¦ó±N¸ê®Æ¶ñ¤JªíÀY©O?

§Ú²{¦b»Ý­n¥Î¨ì±N¬Y¥÷¸ê®ÆÂàÀÉ,´N®tªíÀY¦WºÙ¤ÎÄæ¦ì¤£¦P,¤]¤£¥Î¤ñ¹ï

§Ú¨Ï¥Î³Ì²Âªº¤èªk¿ý»s¥¨¶° ¦ý¬OªíÀY¸ê®Æ¤£ª¾¦p¦ó¿é¤J~¥i¥HÀ°¦£¬Ý¬Ý¶Ü~ÁÂÁÂ

Sub Macro1()
'
' Macro1 Macro
'

'
    Rows("1:1").Select
    ActiveSheet.Paste
    Range("B6").Select
    Workbooks.Open Filename:="C:\Users\Documents\VB\2\A_0814.xlsx"
    Range("A6:A50000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book2").Activate
    ActiveWindow.SmallScroll Down:=-3
    Range("B2").Select
    ActiveSheet.Paste
    Windows("A_0814.xlsx").Activate
    Range("B6:B50000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book2").Activate
    Range("D2").Select
    ActiveSheet.Paste
End Sub

happycoccolin

¦^´_ 38# stillfish00


«¢Åo stillfish00 ¤j¤j

ÁÂÁ±zªº­@¤ß·¾³q»P¨ó§U!
¦¨¥\¤F!!!!!©ñ·Ï¤õ~

¤]ÁÂÁ¦b³oª©À°§U¹L§Úªºª©¤j»Pª©¤Í­Ì

¯uªº«Ü·P¿E¤j®aªº­@¤ß¸Ñ´b

¤]§Æ±æ¦³´Â¤@¤é§Ú¤]¯à¦¨¬°À°§U¤Hªº¨¤¦â

stillfish00

¦^´_ 39# happycoccolin
©êºp¡A½Ð±N .Width ³£§ï¬° .ColumnWidth¡A250§ï¬°¾A¦XªºÄæ¼e(«D¹³¯À)

happycoccolin

¦^´_ 38# stillfish00


    «¢Åo~~~~~~~½Ð°Ý¤@¤U~~¥Ø«eª¬ªp¦p¤U

With .Columns("F")
        If .Width > 250 Then
          .Width = 250 (°»¿ù°±¦b³o¤@¦æ)
          .WrapText = True
        End If
      End With
      With .Columns("M")
        If .Width > 250 Then
          .Width = 250
          .WrapText = True
        End If

"F"Äæ¥i¤£¥Î³vµ§¸ê®Æ¦Û°Ê´«¦C ¥u­n½Õ¾ãÄæ¼e´N¦n

stillfish00

¦^´_ 33# happycoccolin

¤@¹ï¦h­«½Æªº¸ê®Æ¤¤¬O§_¥i¥H¥u¨ú¤£­«½Æªº¨Ã¦b¦P¤@Äæ¦ì¤º°µ´«¦æ°Ê§@©O?
ÁÙ¦³­Y¬O²£¥ÍªºÀɮר䤤¤@Äæ¦ì¤Ó¼e¤j¥i¥H¥ÎVBA³B²zÅý¥L³Ì¤j¥u¨ìÄæ¼e50(¨Ã¦Û°Ê´«¦C)³o¤@Ãþªº³]©w¶Ü?

1. Sub TEST()
   
2.   Const DATABASE_NAME = "A" '¸ê®Æ®w¤u§@ªí¦WºÙ
   
3.   Const DATABASE_COL = 5  'EÄæ
   
4.   Const COMPARE_COL = 11  'KÄæ
   
5.   
   
6.   
   
7.   Dim d, ar, filein, fileout, s As String, i As Long
   
8.   
   
9.   Set d = CreateObject("scripting.dictionary")
   
10.   With Sheets(DATABASE_NAME)
    
11.     ar = .[A1].CurrentRegion.Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
    
12.   End With
    
13.   For i = 2 To UBound(ar)
    
14.     s = Replace(ar(i, DATABASE_COL), "-", "")
    
15.     If s <> "" Then
    
16.       If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
    
17.       d(s)(ar(i, 1)) = ""   '²Ä¤G¼h¦r¨å¡A¥Î¨Ó¿z¿ï±¼­«½ÆªºAÄæ­È
    
18.     End If
    
19.   Next
    
20.   
    
21.   filein = Application.GetOpenFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¿ï¾Ü­n¤ñ¹ïªºÀÉ®×")
    
22.   If Not TypeName(filein) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
    
23.       
    
24.   Application.ScreenUpdating = False
    
25.   With Workbooks.Open(filein).Sheets(1)
    
26.     ar = .[A1].CurrentRegion.Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
    
27.     .Parent.Close False
    
28.   End With
    
29.   Application.ScreenUpdating = True
    
30.   
    
31.   ReDim Preserve ar(LBound(ar) To UBound(ar), LBound(ar, 2) To UBound(ar, 2) + 1)
    
32.   For i = LBound(ar) + 1 To UBound(ar)
    
33.     If ar(i, COMPARE_COL) <> "" Then
    
34.       s = Replace(ar(i, COMPARE_COL), "-", "")
    
35.       If d.exists(s) Then
    
36.         ar(i, UBound(ar, 2)) = Join(d(s).keys, vbLf)
    
37.       Else
    
38.         ar(i, UBound(ar, 2)) = "No Data"
    
39.       End If
    
40.     End If
    
41.   Next
    
42.   
    
43.   With Workbooks.Add
    
44.     Application.ScreenUpdating = False
    
45.     With .Sheets(1).[A1].Resize(UBound(ar), UBound(ar, 2))
    
46.       .Value = ar
    
47.       .Font.Name = "Verdana"  '¦rÅé¦WºÙ
    
48.       .Font.Size = 14 '¦rÅé¤j¤p
    
49.       .Borders.LineStyle = xlContinuous '®Ø½u
    
50.       .EntireColumn.AutoFit '½Õ¾ãÄæ¼e
    
51.       
    
52.       .Rows(1).Interior.Color = 12567966  '¼ÐÀYÃC¦â
    
53.       .Rows(1).Font.Bold = True  '¼ÐÀY²ÊÅé¦r
    
54.       
    
55.       'Äæ¼e­­¨î¤Î¦Û°Ê´«¦æ
    
56.       With .Columns("F")
    
57.         If .Width > 250 Then
    
58.           .Width = 250
    
59.           .WrapText = True
    
60.         End If
    
61.       End With
    
62.       With .Columns("M")
    
63.         If .Width > 250 Then
    
64.           .Width = 250
    
65.           .WrapText = True
    
66.         End If
    
67.       End With
    
68.     End With
    
69.     Application.ScreenUpdating = True
    
70.    
    
71.     If MsgBox("¬O§_­nÀx¦sÀÉ®×?", vbYesNo) = vbYes Then
    
72.       fileout = Application.GetSaveAsFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¥t¦s¬°·sÀÉ")
    
73.       If Not TypeName(fileout) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
    
74.       .SaveAs fileout, FileFormat:=xlWorkbookDefault
    
75.     End If
    
76.   End With
    
77. End Sub

½Æ»s¥N½X