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

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

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

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

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

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

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

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

¥»©«³Ì«á¥Ñ 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

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

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2013-8-15 17:49 ½s¿è

¦^´_ 46# happycoccolin
­Y¦³ªºÀɮ׬OB5Äæ¶}©l¦³ªº¬OB6Äæ¶}©l ¥i¥H«ç»ò§PÂ_?

¤£ª¾¹D¡A
¦Ó¥B§AªºA_0814.xlsxÀÉ®×®¼©Çªº¡I
[A4]Àx¦s®æ©ú©ú¨S¤å¦r(¤]¨S¦³¤£¥i¨£¦r¤¸)¡A«o¤S¤£¬OªÅ¥ÕÀx¦s®æ(´M§ä>¯S®í¥Ø¼Ð>ªÅ¥Õ¡A¤£·|§ä¨ì)
¥ÎCtrl+¤W¤U¤]³£·|¸õ¹L¡C

²Ä¤@¦¸¹J¨ì³oºØ±¡§Î~

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

§ï¤@¤U
  1.   arNewHeader = Array("Q", "W", "E", "R", "T", "Y", "U", "I") '¦Û¤v¶ñ¤W¥þ³¡·s¼ÐÃD¦WºÙ
½Æ»s¥N½X
ÁÙ¦³³oÃä
  1.     With .Sheets(1)
  2.       For i = LBound(cIndexOld) To UBound(cIndexOld)
  3.         .Cells(1, cIndexNew(i)).Resize(r).Value = Application.WorksheetFunction.Index(ar, 0, cIndexOld(i))
  4.       Next
  5.       .[A1].Resize(, UBound(arNewHeader) + 1).Value = arNewHeader
  6.     End With
½Æ»s¥N½X

TOP

¦^´_ 48# stillfish00


    «¢ÅoS¤j~§Ú¸Õ¹L¤F~~~·P¿E¤£ºÉ~

·Q½Ð°Ý¤@¤U­Y¬O§Ú­n¶]¸ê®Æ±qB5¶}©lªº ¬O­n­×§ï­þÃä©O?

ÁÙ¬O¥i¥H¥Î§PÂ_TITLE³oºØ¤è¦¡³B²z¶Ü?

EX:­YTITLE(B4)¬O"Item"´N±q¤U¤@®æ(B5)¶}©l¨ú¸ê®Æ ¤@Ãþªº

¤£¦n·N«ä..¤S¥H¤@¯ë¤Hªº·Qªk¨Ó´£°Ý~@@

ÁÂÁÂS¤jªº­@¤ß»PÀ°¦£

TOP

¦^´_ 49# happycoccolin
  1. Sub TEST()
  2.   Dim ar, r As Long, i As Long
  3.   Dim cIndexOld, cIndexNew, arNewHeader
  4.   Dim f, findTitle
  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("Q", "W", "E", "R", "T", "Y", "U", "I") '¦Û¤v¶ñ¥þ³¡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.       Set findTitle = .Cells.Find("Item", , xlValues, xlWhole, xlByRows, xlNext)  '§ä¼ÐÃD Item
  17.       If findTitle Is Nothing Then MsgBox "§ä¤£¨ì¼ÐÃD": Exit Sub
  18.       
  19.       With findTitle.CurrentRegion
  20.         ar = .Parent.Range(findTitle, .Cells(.Rows.Count, .Columns.Count)).Value
  21.       End With
  22.     End With
  23.     .Close False
  24.   End With
  25.   Application.ScreenUpdating = True
  26.   
  27.   r = UBound(ar)
  28.   With Workbooks.Add
  29.     With .Sheets(1)
  30.       For i = LBound(cIndexOld) To UBound(cIndexOld)
  31.         .Cells(1, cIndexNew(i)).Resize(r).Value = Application.WorksheetFunction.Index(ar, 0, cIndexOld(i))
  32.       Next
  33.       .[A1].Resize(, UBound(arNewHeader) + 1).Value = arNewHeader
  34.     End With
  35.    
  36.     If MsgBox("¬O§_­nÀx¦sÀÉ®×?", vbYesNo) = vbYes Then
  37.       f = Application.GetSaveAsFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¥t¦s¬°·sÀÉ")
  38.       If Not TypeName(f) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  39.       .SaveAs f, FileFormat:=xlWorkbookDefault
  40.     End If
  41.   End With
  42. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : §Ñ¥\¤£§Ñ¹L¡A§Ñ«è¤£§Ñ®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD