snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Function pull(xref As String) As Variant
'inspired by Bob Phillips and Laurent Longre
'but written by Harlan Grove
'-----------------------------------------------------------------
'Copyright (c) 2003 Harlan Grove.
'
'This code is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published
'by the Free Software Foundation; either version 2 of the License,
'or (at your option) any later version.
'-----------------------------------------------------------------
Dim xlapp As Object, xlwb As Workbook
Dim b As String, r As Range, c As Range, n As Long
pull = Evaluate(xref)
If CStr(pull) = CStr(CVErr(xlErrRef)) Then
On Error GoTo CleanUp 'immediate clean-up at this point
Set xlapp = CreateObject("Excel.Application")
Set xlwb = xlapp.Workbooks.Add 'needed by .ExecuteExcel4Macro
On Error Resume Next 'now clean-up can wait
n = InStr(InStr(1, xref, "]") + 1, xref, "!")
b = Mid(xref, 1, n)
Set r = xlwb.Sheets(1).Range(Mid(xref, n + 1))
If r Is Nothing Then
pull = xlapp.ExecuteExcel4Macro(xref)
Else
For Each c In r
c.Value = xlapp.ExecuteExcel4Macro(b & c.address(1, 1, xlR1C1))
Next c
pull = r.Value
End If
CleanUp:
If Not xlwb Is Nothing Then xlwb.Close 0
If Not xlapp Is Nothing Then xlapp.Quit
Set xlapp = Nothing
End If
End Function
You do not have the required permissions to view the files attached to this post.
Sub Test0()
Dim rAll As Range
Dim r As Range, strSource As String
With Sheets("Sheet1")
Set rAll = .Range("g1", .Range("g" & .Rows.Count).End(xlUp))
For Each r In rAll
strSource = "'" & r.Offset(0, -3) & "[" & r.Offset(0, -2) & "]" & _
r.Offset(0, -1) & "'!"
r.Offset(0, 2).Formula = "=" & strSource & r.Value
r.Offset(0, 3).Formula = "=" & strSource & r.Offset(0, 1).Value
Next r
End With
End Sub
Sub Test0()
Dim rAll As Range
Dim r As Range, strSource As String
With Sheets("Sheet1")
Set rAll = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
For Each r In rAll
strSource = "'" & r.Offset(0, -3) & "[" & r.Offset(0, -2) & "]" & _
r.Offset(0, -1) & "'!"
r.Offset(0, 2).Formula = "=" & strSource & r.Value
Next r
End With
End Sub
You do not have the required permissions to view the files attached to this post.
Sub Test()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet
dirName = "C:\Users\humno\OneDrive\à´Ê¡ì·çÍ»\test\"
MyPath = dirName & "*.xlsx"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile
Do While MyFile <> ""
If Len(MyFile) = 0 Then Exit Do
Workbooks.Open MyFile
With ActiveWorkbook
For Each wks In .Worksheets
wks.Range("A1").Value = "Toye"
wks.Range("A2").Value = "Boye4"
Next
End With
ActiveWorkbook.Close SaveChanges:=True
MyFile = Dir
If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub
You do not have the required permissions to view the files attached to this post.
Sub Test0()
Dim rAll As Range
Dim r As Range, strSource As String
With Sheets("Sheet1")
Set rAll = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
For Each r In rAll
strSource = r.Offset(0, -3) & r.Offset(0, -2)
Workbooks.Open Filename:=(strSource)
ActiveSheet.Range("A1").Value = Sheet1.Range("F2")
ActiveWorkbook.Save
ActiveWorkbook.Close
Next r
End With
End Sub
You do not have the required permissions to view the files attached to this post.
Dim rAll As Range, tgBook As Workbook
Dim r As Range, strSource As String
Dim d As Object, x() As Variant, i As Integer
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
Set rAll = .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
For Each r In rAll
strSource = r.Offset(0, -1).Value & r.Value
If Not d.Exists(strSource) Then
d.Add Key:=strSource, Item:=strSource
End If
Next r
x = d.keys
For i = 0 To UBound(x)
Set tgBook = Workbooks.Open(Filename:=x(i))
For Each r In rAll
If tgBook.Name = r.Value Then
With tgBook.Worksheets(r.Offset(0, 1).Value)
.Range(r.Offset(0, 2).Value) = r.Offset(0, 4).Value
.Range(r.Offset(0, 3).Value) = r.Offset(0, 5).Value
End With
End If
Next r
tgBook.Save
tgBook.Close
Next i
End With
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
