ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð°ÝVBA¥i¥H°µ¨ì¨âÀɮפñ¹ï«á¦A²£¥Í¥t¤@Àɮתº¤ñ¹ïµ²ªG¶Ü?

¦^´_ 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

TOP

¥»©«³Ì«á¥Ñ happycoccolin ©ó 2013-8-15 15:54 ½s¿è

¦^´_ 43# stillfish00


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

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

ÁÂÁÂStillfish00¤j¤j!

TEST_130815.zip (12.98 KB)

TOP

¦^´_ 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

TOP

¦^´_ 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ªº¦^ÂÐ~~

TOP

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

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

TOP

¦^´_ 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

TOP

¦^´_ 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ªº¨¤¦â

TOP

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

TOP

¥»©«³Ì«á¥Ñ happycoccolin ©ó 2013-8-2 14:32 ½s¿è

¦^´_ 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

TOP

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2013-8-2 14:13 ½s¿è

¦^´_ 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

TOP

        ÀR«ä¦Û¦b : ¬°¤H³B¥@­n¤p¤ß²Ó¤ß¡A¦ý¤£­n¡u¤p¤ß²´¡v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD