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

¦p¦ó±qAªíÄæ¦ì¦WºÙ¥h·j´MBªí¹ïÀ³ªºÄæ¦ì¦WºÙ,¨Ã±NBªíªº¤º®e¶K¨ìAªí

¦p¦ó±qAªíÄæ¦ì¦WºÙ¥h·j´MBªí¹ïÀ³ªºÄæ¦ì¦WºÙ,¨Ã±NBªíªº¤º®e¶K¨ìAªí

Dearª©¤j
§Ú¼g¤F¤@­ÓMarcoµ{¦¡¥h§ì¨ú¥t¥~¤@­Ó¸ê®Æ(vsDataAnrFunction)ªº¤º®e,¸Óµ{¦¡¬O¥Î¤wª¾ªºÄæ¦ì(¦p:A,B,C...Äæ¦ì)¥h§ì¨ú,¦ý¥Ø«eµo²{¥u­n¸ê®Æ(vsDataAnrFunction)ªºÄæ¦ìÅܤF,´N·|¾É­P§Ú®³¨ì¿ù»~ªº¸ê®Æ,©Ò¥H§Ú·Q½Ð°Ý¤j¤j,¦p¦ó¨Ï¥ÎÄæ¦ì¦WºÙ¥h§ì¨ú¸ê®Æ(vsDataAnrFunction)ªº¤º®e.

1206¸ß°Ý.rar (106.96 KB)

Sub MO()
Dim C&, R&, xD, xB As Workbook, Arr, Brr, U&, N&
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("Dump")
    .UsedRange.Offset(1, 0).EntireRow.Delete
    For C = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
        xD(.Cells(1, C) & "") = C: N = N + 1
    Next
End With
On Error Resume Next
Set xB = Workbooks("vsDataAnrFunction.csv")
On Error GoTo 0
If xB Is Nothing Then Set xB = Workbooks.Open(ThisWorkbook.Path & "\vsDataAnrFunction.csv")
Arr = xB.Sheets(1).UsedRange
ReDim Brr(1 To UBound(Arr), 1 To N)
For C = 1 To UBound(Arr, 2)
    U = xD(Arr(1, C) & ""): If U = 0 Then GoTo 101
For R = 2 To UBound(Arr)
    Brr(R - 1, U) = Arr(R, C)
Next R
101: Next C
xB.Close 0
Sheets("Dump").[A2].Resize(UBound(Arr) - 1, N).Value = Brr
End Sub


'================================

TOP

Dear ª©¤j
¯uªº«D±`ªº·PÁÂ~~
§Ú·|¬ãŪ¤@¤U,­è¤~¬ãŪ¤@¤U¯uªº¦³µ{«×,§Ú·|google´M§ä,­Y¦³ºÃ°Ý¦A½Ðª©¥D¸ÑÄÀ,(§Ú¼gªº´N¹³¥®¸X¶é¯Z¨Ì¼Ë)

TOP

¥t¤è:
Sub MO_2()
Dim MyBook As Workbook, MySht As Worksheet, xR As Range, xF As Range
Dim FN$, xB As Workbook, xArea As Range
Application.ScreenUpdating = False
Set MyBook = ThisWorkbook '¥»ÀÉ
FN = "vsDataAnrFunction.csv" 'csvÀɮצWºÙ
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0 'ÀˬdcsvÀɬO§_¤w¶}±Ò
If xB Is Nothing Then Set xB = Workbooks.Open(MyBook.Path & "\" & FN) '­YcsvÀÉ¥¼¶}±Ò, ¶}±Ò¤§
Set xArea = xB.Sheets(1).UsedRange '³]©wcsvÀɸê®Æ½d³ò¬°rangeª«¥ó
'------------------------------------
Set MySht = MyBook.Sheets("Dump") '¥»Àɸê®Æ¤u§@ªí
MySht.UsedRange.Offset(1, 0).EntireRow.Delete '²M°£­ì¦³¸ê®Æ(«O¯d¼ÐÃD¦æ)
For Each xR In Range(MySht.[A1], MySht.Cells(1, Columns.Count).End(xlToLeft))
    Set xF = xArea.Rows(1).Find(xR, Lookat:=xlWhole) '³v¤@´M§äcsv²Ä¤@¦æ²Å¦X¼ÐÃD¤å¦rªº¦ì¸m
    If xF Is Nothing Then GoTo 101  '§ä¤£¨ì²Å¦X®É, ²¤¹L
    xR.Resize(xArea.Rows.Count).Value = xF.Resize(xArea.Rows.Count).Value '½Æ»s¾ãÄæ¸ê®Æ
101: Next
xB.Close 0
End Sub


'=======================================

TOP

        ÀR«ä¦Û¦b : ¨ü¤HÂI¤ô¤§®¦¡A¶··í´é¬u¥H³ø¡C
ªð¦^¦Cªí ¤W¤@¥DÃD