Xin giúp đỡ em về cách mở file từ 1 thư mục (1 người xem)

[vanlemon]

Em có một vấn đề là:

Các file dữ liệu của em nằm ở 1 thư mục. Chẳng bạn là ở Desktop
Bây giờ làm cách nào để chọn đường dẫn và copy dữ liệu các file này vào file VBA ?

Xin các bạn giúp em với nhé.

 

[vanlemon]

Giúp em với các anh chị ơi....

 

[be_09]

Giúp em với các anh chị ơi....

Giúp là giúp cái gì?

Bạn nêu vấn đề chưa rỏ, giúp mỗi File là 1 sheet hay gộp tất cả các File vào 1 sheet hay mỗi sheet trong các File kia tương ứng với mỗi sheet trong File VBA.

 

[vanlemon]

Giúp là giúp cái gì?

Bạn nêu vấn đề chưa rỏ, giúp mỗi File là 1 sheet hay gộp tất cả các File vào 1 sheet hay mỗi sheet trong các File kia tương ứng với mỗi sheet trong File VBA.

Em nêu rõ rồi mà anh.
Em có 3 file:
1.VBA
2.Dữ liệu 1
3. Dữ liệu 2
Vấn đề của em là đang ở file VBA. Dùng lệnh mở file Dữ liệu 1 & Dữ liệu 2 sau đó copy toàn bộ dữ liệu 2 file kia dán vào file VBA ạ

 

[hung2412]

Em nêu rõ rồi mà anh.
Em có 3 file:
1.VBA
2.Dữ liệu 1
3. Dữ liệu 2
Vấn đề của em là đang ở file VBA. Dùng lệnh mở file Dữ liệu 1 & Dữ liệu 2 sau đó copy toàn bộ dữ liệu 2 file kia dán vào file VBA ạ

Code cùi:
[GPECODE=vb]Sub CopyandPaste()
Dim i As Long, FileOpen As String
Dim WbVBA As String
WbVBA = ActiveWorkbook.Name
For i = 1 To 2
FileOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls")
Workbooks.Open(FileOpen, , , , "").Activate
Range([A2], [C65536].End(xlUp)).Copy Workbooks("" & WbVBA & "").Sheets(1).[A65536].End(xlUp).Offset(1, 0)
ActiveWorkbook.Close
Next
End Sub[/GPECODE]
Bạn phải đang ở File VBA => Chạy Code => Hiện hộp thoại lần thứ 1 thì bạn chọn đường dẫn đến nơi lưu File Dữ liệu 1 => Hiện hộp thoại lần thứ 2 thì bạn chọn đường dẫn đến nơi lưu File Dữ liệu 2 => Xong.

 

[nmhung49]

Em nêu rõ rồi mà anh.
Em có 3 file:
1.VBA
2.Dữ liệu 1
3. Dữ liệu 2
Vấn đề của em là đang ở file VBA. Dùng lệnh mở file Dữ liệu 1 & Dữ liệu 2 sau đó copy toàn bộ dữ liệu 2 file kia dán vào file VBA ạ

Có thể dùng code này

[GPECODE=vb]
Sub Test()
Dim rng As Range, i As Long
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Application.FileDialog(msoFileDialogOpen)
.Parent.ScreenUpdating = False
.Title = "Chon file chep ve de Tong hop"
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Excel files", "*.xls"
.Show
If .SelectedItems.Count Then
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
Sheets("Sheet1").Range("A1").CurrentRegion.Offset(1).Copy rng
.Close False
End With
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
Next
End If
.Parent.ScreenUpdating = True
End With
End Sub


[/GPECODE]

 

[vanlemon]

Có thể dùng code này

[GPECODE=vb]
Sub Test()
Dim rng As Range, i As Long
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Application.FileDialog(msoFileDialogOpen)
.Parent.ScreenUpdating = False
.Title = "Chon file chep ve de Tong hop"
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Excel files", "*.xls"
.Show
If .SelectedItems.Count Then
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
Sheets("Sheet1").Range("A1").CurrentRegion.Offset(1).Copy rng
.Close False
End With
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
Next
End If
.Parent.ScreenUpdating = True
End With
End Sub


[/GPECODE]

Ôi tuyệt vời luôn....Em xin chân thành cám ơn ạ

Bạn làm ơn cho mình hỏi : Mình muốn mở file txt từ một thư mục và thứ tự mở như hình ảnh mình đính kèm thì chỉnh code lại như thế nào nhỉ?
Xin chân thành cám ơn bạn nhé.

 

[nmhung49]

Ôi tuyệt vời luôn....Em xin chân thành cám ơn ạ

Bạn làm ơn cho mình hỏi : Mình muốn mở file txt từ một thư mục và thứ tự mở như hình ảnh mình đính kèm thì chỉnh code lại như thế nào nhỉ?
Xin chân thành cám ơn bạn nhé.

Mở text file phải viết khác rồi ah bạn đưa file đính kèm lên đi

 

[vanlemon]

Mở text file phải viết khác rồi ah bạn đưa file đính kèm lên đi

Gởi bạn

File TXT mình xin đính kèm
Còn thao tác mở bằng tay thì như hình ảnh đính kèm comment trên của mình ạ
Tại vì mở bằng tay cả trăm file mỏi tay quá nên mình muốn có cách nào xài VBA cho nó lẹ ạ
Cám ơn bạn trước nhé

 

[nmhung49]

Gởi bạn

File TXT mình xin đính kèm
Còn thao tác mở bằng tay thì như hình ảnh đính kèm comment trên của mình ạ
Tại vì mở bằng tay cả trăm file mỏi tay quá nên mình muốn có cách nào xài VBA cho nó lẹ ạ
Cám ơn bạn trước nhé

Thử lại code này

[GPECODE=vb]
Sub Test()
Dim rng As Range, i As Long
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Application.FileDialog(msoFileDialogOpen)
.Parent.ScreenUpdating = False
.Title = "Chon file chep ve de Tong hop"
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Text files", "*.txt"
.Show
If .SelectedItems.Count Then
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
.ActiveSheet.Range("A1").CurrentRegion.Offset(1).Copy rng
.Close False
End With
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
Next
End If
.Parent.ScreenUpdating = True
End With


End Sub


[/GPECODE]

 

[vanlemon]

Thử lại code này

[GPECODE=vb]
Sub Test()
Dim rng As Range, i As Long
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Application.FileDialog(msoFileDialogOpen)
.Parent.ScreenUpdating = False
.Title = "Chon file chep ve de Tong hop"
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Text files", "*.txt"
.Show
If .SelectedItems.Count Then
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
.ActiveSheet.Range("A1").CurrentRegion.Offset(1).Copy rng
.Close False
End With
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
Next
End If
.Parent.ScreenUpdating = True
End With


End Sub


[/GPECODE]

Ui. Code này nó dán all dữ liệu luôn (Trong khi dữ liệu mình cần mở thì cột 1 bỏ đi bạn ơi)

Mình dùng Marco thì code như sau:

Sub Macro1()
'
' Macro1 Macro
'


'
Workbooks.OpenText Filename:= _
"C:\Documents and Settings\Administrator\Desktop\a2.txt", Origin:=932, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), Array(2, 1), Array( _
3, 1)), TrailingMinusNumbers:=True
End Sub


Tuy nhiên nhược điểm là mình không biết làm cách nào để chọn mở nhiều file một lần ( Macro nó chỉ định mở 1 file với name cụ thể mất rồi)

 

[nmhung49]

Ui. Code này nó dán all dữ liệu luôn (Trong khi dữ liệu mình cần mở thì cột 1 bỏ đi bạn ơi)

Mình dùng Marco thì code như sau:

Sub Macro1()
'
' Macro1 Macro
'


'
Workbooks.OpenText Filename:= _
"C:\Documents and Settings\Administrator\Desktop\a2.txt", Origin:=932, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), Array(2, 1), Array( _
3, 1)), TrailingMinusNumbers:=True
End Sub


Tuy nhiên nhược điểm là mình không biết làm cách nào để chọn mở nhiều file một lần ( Macro nó chỉ định mở 1 file với name cụ thể mất rồi)

Tôi làm cho bạn 2 code bạn thích code nào thì sử dụng code đó

[GPECODE=vb]
Sub Macro1()
Dim Fname, rng As Range, i As Long
Fname = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
If TypeName(Fname) <> "Boolean" Then
For i = 1 To UBound(Fname)
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Workbooks
.OpenText Fname(i), Origin:=932, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), Array(2, 1), Array( _
3, 1)), TrailingMinusNumbers:=True
With ActiveWorkbook
.ActiveSheet.Range("A1").CurrentRegion.Offset(1).Copy rng
.Close (False)
End With
End With
Next i
End If
.ScreenUpdating = True
.DisplayAlerts = True
End With


End Sub


Sub Test()
Dim rng As Range, i As Long
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Application.FileDialog(msoFileDialogOpen)
.Parent.ScreenUpdating = False
.Title = "Chon file chep ve de Tong hop"
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Text files", "*.txt"
.Show
If .SelectedItems.Count Then
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
.ActiveSheet.Range("A1").CurrentRegion.Offset(1, 1).Copy rng
.Close False
End With
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
Next
End If
.Parent.ScreenUpdating = True
End With

End Sub
[/GPECODE]

 

[hung2412]

Tôi làm cho bạn 2 code bạn thích code nào thì sử dụng code đó

[GPECODE=vb]
Sub Macro1()
Dim Fname, rng As Range
Fname = Application.GetOpenFilename("Text Files (*.txt), *.txt")
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
If TypeName(Fname) = "String" Then
With Workbooks
.OpenText Fname, Origin:=932, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), Array(2, 1), Array( _
3, 1)), TrailingMinusNumbers:=True
With ActiveWorkbook
.ActiveSheet.Range("A1").CurrentRegion.Offset(1).Copy rng
.Close (False)
End With
End With
End If
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub


Sub Test()
Dim rng As Range, i As Long
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Application.FileDialog(msoFileDialogOpen)
.Parent.ScreenUpdating = False
.Title = "Chon file chep ve de Tong hop"
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Text files", "*.txt"
.Show
If .SelectedItems.Count Then
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
.ActiveSheet.Range("A1").CurrentRegion.Offset(1, 1).Copy rng
.Close False
End With
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
Next
End If
.Parent.ScreenUpdating = True
End With

End Sub
[/GPECODE]

Bạn nên tách 2 Code thành dạng như vầy để dễ nhìn (Và dễ chọn lựa):
[GPECODE=vb]Code 1[/GPECODE]
và [GPECODE=vb] Code 2[/GPECODE]

 

[vanlemon]

Tôi làm cho bạn 2 code bạn thích code nào thì sử dụng code đó

[GPECODE=vb]
Sub Macro1()
Dim Fname, rng As Range, i As Long
Fname = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
If TypeName(Fname) <> "Boolean" Then
For i = 1 To UBound(Fname)
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Workbooks
.OpenText Fname(i), Origin:=932, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), Array(2, 1), Array( _
3, 1)), TrailingMinusNumbers:=True
With ActiveWorkbook
.ActiveSheet.Range("A1").CurrentRegion.Offset(1).Copy rng
.Close (False)
End With
End With
Next i
End If
.ScreenUpdating = True
.DisplayAlerts = True
End With


End Sub


Sub Test()
Dim rng As Range, i As Long
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
With Application.FileDialog(msoFileDialogOpen)
.Parent.ScreenUpdating = False
.Title = "Chon file chep ve de Tong hop"
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Text files", "*.txt"
.Show
If .SelectedItems.Count Then
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
.ActiveSheet.Range("A1").CurrentRegion.Offset(1, 1).Copy rng
.Close False
End With
Set rng = Sheet1.Range("A65000").End(xlUp).Offset(1)
Next
End If
.Parent.ScreenUpdating = True
End With

End Sub
[/GPECODE]

Quá tuyệt luôn bạn ơi. Mình vừa đi làm về Test thử code quá tốt luôn.
Bạn ơi mình còn 2 vấn đề nữa mong bạn dùng VBA giải quyết cho mình với

Mình xin gởi file kèm ạ

Vấn đề là: Làm sao khi trong cùng một Mã hàng có hai hoặc nhiều Tên hàng giống nhau thì lập tức xoá hết chỉ để lại 1 dòng và tính tổng giá tiền nhỉ?

Bạn giúp mình với nhé

 

[hung2412]

Quá tuyệt luôn bạn ơi. Mình vừa đi làm về Test thử code quá tốt luôn.
Bạn ơi mình còn 2 vấn đề nữa mong bạn dùng VBA giải quyết cho mình với

Mình xin gởi file kèm ạ

Vấn đề là: Làm sao khi trong cùng một Mã hàng có hai hoặc nhiều Tên hàng giống nhau thì lập tức xoá hết chỉ để lại 1 dòng và tính tổng giá tiền nhỉ?

Bạn giúp mình với nhé

Bạn nên mở đề tài mới vì vấn đề mới này không liên quan tới Đề tài này.

 

[vanlemon]

Bạn nên mở đề tài mới vì vấn đề mới này không liên quan tới Đề tài này.

Mình nghĩ mở thêm thành ra nó nhiều quá
Nên mong muốn gói gọn ở đây ạ

 

[hung2412]

Bạn ơi mình còn 2 vấn đề nữa mong bạn dùng VBA giải quyết cho mình với

Mình xin gởi file kèm ạ

Vấn đề là: Làm sao khi trong cùng một Mã hàng có hai hoặc nhiều Tên hàng giống nhau thì lập tức xoá hết chỉ để lại 1 dòng và tính tổng giá tiền nhỉ?

Bạn giúp mình với nhé

Chỉ để lại 1 dòng thì dễ rồi nhưng mà bạn muốn tên hàng nào để lại (Vì nhiều tên hàng khác nhau nhưng cùng một mã hàng)?

 

[vanlemon]

Chỉ để lại 1 dòng thì dễ rồi nhưng mà bạn muốn tên hàng nào để lại (Vì nhiều tên hàng khác nhau nhưng cùng một mã hàng)?

Tên hàng nào cũng phải giữ lại bạn à. Chỉ xoá những tên hàng giống nhau thôi ạ

[TABLE="width: 256"]
[TR]
[TD]Mã hàng[/TD]
[TD]Tên hàng[/TD]
[TD]Giá tiền[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]13632[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]28280[/TD]
[/TR]
[/TABLE]

Ví dụ thế này thì sẽ xoá bớt một dòng và cộng giá tiền lại ạ

[TABLE="width: 256"]
[TR]
[TD]Mã hàng[/TD]
[TD]Tên hàng[/TD]
[TD]Giá tiền[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]41912[/TD]
[/TR]
[/TABLE]

 

[nmhung49]

Tên hàng nào cũng phải giữ lại bạn à. Chỉ xoá những tên hàng giống nhau thôi ạ

[TABLE="width: 256"]
[TR]
[TD]Mã hàng[/TD]
[TD]Tên hàng[/TD]
[TD]Giá tiền[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]13632[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]28280[/TD]
[/TR]
[/TABLE]

Ví dụ thế này thì sẽ xoá bớt một dòng và cộng giá tiền lại ạ

[TABLE="width: 256"]
[TR]
[TD]Mã hàng[/TD]
[TD]Tên hàng[/TD]
[TD]Giá tiền[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]Sách 1[/TD]
[TD="align: right"]41912[/TD]
[/TR]
[/TABLE]

Thử code này

[GPECODE=vb]
Sub Congdon()
Dim dic As Object
Dim i As Long, dulieu, tam, index As Long, k As Long
Set dic = CreateObject("Scripting.Dictionary")
dulieu = Range("A2:C15").Value
For i = 1 To UBound(dulieu)
tam = dulieu(i, 1) & dulieu(i, 2)
If Not dic.Exists(tam) Then
k = k + 1
dic.Add tam, k
dulieu(k, 1) = dulieu(i, 1)
dulieu(k, 2) = dulieu(i, 2)
dulieu(k, 3) = dulieu(i, 3)
Else
index = dic.Item(tam)
dulieu(index, 3) = dulieu(index, 3) + dulieu(k, 3)
End If
Next
Range("E1").Resize(k, 3).Value = dulieu
End Sub


[/GPECODE]

 

[vanlemon]

Thử code này

[GPECODE=vb]
Sub Congdon()
Dim dic As Object
Dim i As Long, dulieu, tam, index As Long, k As Long
Set dic = CreateObject("Scripting.Dictionary")
dulieu = Range("A2:C15").Value
For i = 1 To UBound(dulieu)
tam = dulieu(i, 1) & dulieu(i, 2)
If Not dic.Exists(tam) Then
k = k + 1
dic.Add tam, k
dulieu(k, 1) = dulieu(i, 1)
dulieu(k, 2) = dulieu(i, 2)
dulieu(k, 3) = dulieu(i, 3)
Else
index = dic.Item(tam)
dulieu(index, 3) = dulieu(index, 3) + dulieu(k, 3)
End If
Next
Range("E1").Resize(k, 3).Value = dulieu
End Sub


[/GPECODE]

Hic
Code này sẽ tính toán và ghi giá trị sang cột E1

Không có cách nào để nó thực hiện luôn trên cột A,B,C được à bạn ơi

 

[nmhung49]

Hic
Code này sẽ tính toán và ghi giá trị sang cột E1

Không có cách nào để nó thực hiện luôn trên cột A,B,C được à bạn ơi

Sửa chỗ này
Range("E1").Resize(k, 3).Value = dulieu
Thành
Range("A2").Resize(k, 3).Value = dulieu

 

[vanlemon]

Sửa chỗ này
Range("E1").Resize(k, 3).Value = dulieu
Thành
Range("A2").Resize(k, 3).Value = dulieu

Gởi bạn
Lúc nãy em có thử chuyển thành
Range("A2").Resize(k, 3).Value = dulieu

Nhưng khi chuyển thì phát sinh vấn đề là:
1. Các dòng còn thừa ra nó không chịu xoá đi
2. Bấm chạy thêm phát nữa thì nó cộng đồn giá trị ở đâu vào ấy

 

[nmhung49]

Gởi bạn
Lúc nãy em có thử chuyển thành
Range("A2").Resize(k, 3).Value = dulieu

Nhưng khi chuyển thì phát sinh vấn đề là:
1. Các dòng còn thừa ra nó không chịu xoá đi
2. Bấm chạy thêm phát nữa thì nó cộng đồn giá trị ở đâu vào ấy

Ah quen

[GPECODE=vb]
​Sub Congdon()Dim dic As Object
Dim i As Long, dulieu, tam, index As Long, k As Long
Set dic = CreateObject("Scripting.Dictionary")
dulieu = Range("A2:C15").Value
For i = 1 To UBound(dulieu)
tam = dulieu(i, 1) & dulieu(i, 2)
If Not dic.Exists(tam) Then
k = k + 1
dic.Add tam, k
dulieu(k, 1) = dulieu(i, 1)
dulieu(k, 2) = dulieu(i, 2)
dulieu(k, 3) = dulieu(i, 3)
Else
index = dic.Item(tam)
dulieu(index, 3) = dulieu(index, 3) + dulieu(k, 3)
End If
Next
Range("A2:C15").ClearContents
Range("A2").Resize(k, 3).Value = dulieu
End Sub



[/GPECODE]

 

[vanlemon]

Ah quen

[GPECODE=vb]
​Sub Congdon()Dim dic As Object
Dim i As Long, dulieu, tam, index As Long, k As Long
Set dic = CreateObject("Scripting.Dictionary")
dulieu = Range("A2:C15").Value
For i = 1 To UBound(dulieu)
tam = dulieu(i, 1) & dulieu(i, 2)
If Not dic.Exists(tam) Then
k = k + 1
dic.Add tam, k
dulieu(k, 1) = dulieu(i, 1)
dulieu(k, 2) = dulieu(i, 2)
dulieu(k, 3) = dulieu(i, 3)
Else
index = dic.Item(tam)
dulieu(index, 3) = dulieu(index, 3) + dulieu(k, 3)
End If
Next
Range("A2:C15").ClearContents
Range("A2").Resize(k, 3).Value = dulieu
End Sub



[/GPECODE]

Hihi

Lần thứ nhất chạy thì kết quả nó đúng. Chỉ là ô C3 nó có giá trị 0 ( không biết sao có em số 0 này ạ)

Lần thứ 2 chạy thì sai. Không biết nó lấy giá trị cũ ở đâu mà cộng dồn vào bạn ơi ;(

 

[nmhung49]

Hihi

Lần thứ nhất chạy thì kết quả nó đúng. Chỉ là ô C3 nó có giá trị 0 ( không biết sao có em số 0 này ạ)

Lần thứ 2 chạy thì sai. Không biết nó lấy giá trị cũ ở đâu mà cộng dồn vào bạn ơi ;(

Tôi kiểm tra vẫn vậy cho dù chạy n lần vẫn thế file bạn lấy file nào kiểm tra đừng nói là lấy file khác không phải file upload đi, tôi không thích cách phản hồi của bạn như thế rồi đó phải đưa file lên kiểm chứng chứ.

 

[vanlemon]

Tôi kiểm tra vẫn vậy cho dù chạy n lần vẫn thế file bạn lấy file nào kiểm tra đừng nói là lấy file khác không phải file upload đi, tôi không thích cách phản hồi của bạn như thế rồi đó phải đưa file lên kiểm chứng chứ.

Dạ em gởi file lên anh ơi

Lần 1 em chạy phát thì ô C3 nó hiện số 0 ạ
Sau đó em thử Ctrl+D vùng A2:C10 để thử lần 2 thì kết quả nó lại không đúng.
Mong anh giúp em với, em thực sự không biết gì nhiều về VBA cả

 

[nmhung49]

Dạ em gởi file lên anh ơi

Lần 1 em chạy phát thì ô C3 nó hiện số 0 ạ
Sau đó em thử Ctrl+D vùng A2:C10 để thử lần 2 thì kết quả nó lại không đúng.
Mong anh giúp em với, em thực sự không biết gì nhiều về VBA cả

Code trước tôi chỉ làm dữ liệu giả lập của bạn nên code này tổng quát hơn copy code này vào file trên chạy code

[GPECODE=vb]
Sub Congdon()
Dim dic As Object
Dim i As Long, dulieu, tam, index As Long, k As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1").Range("A2:C" & [A1048576].End(3).Row)
dulieu = .Value
For i = 1 To UBound(dulieu)
tam = dulieu(i, 1) & dulieu(i, 2)
If Not dic.Exists(tam) Then
k = k + 1
dic.Add tam, k
dulieu(k, 1) = dulieu(i, 1)
dulieu(k, 2) = dulieu(i, 2)
dulieu(k, 3) = dulieu(i, 3)
Else
index = dic.Item(tam)
dulieu(index, 3) = dulieu(index, 3) + dulieu(k, 3)
End If
Next
.ClearContents
.Parent.Range("A2").Resize(k, 3).Value = dulieu
End With
End Sub


[/GPECODE]

 

[vanlemon]

Code trước tôi chỉ làm dữ liệu giả lập của bạn nên code này tổng quát hơn copy code này vào file trên chạy code

[GPECODE=vb]
Sub Congdon()
Dim dic As Object
Dim i As Long, dulieu, tam, index As Long, k As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1").Range("A2:C" & [A1048576].End(3).Row)
dulieu = .Value
For i = 1 To UBound(dulieu)
tam = dulieu(i, 1) & dulieu(i, 2)
If Not dic.Exists(tam) Then
k = k + 1
dic.Add tam, k
dulieu(k, 1) = dulieu(i, 1)
dulieu(k, 2) = dulieu(i, 2)
dulieu(k, 3) = dulieu(i, 3)
Else
index = dic.Item(tam)
dulieu(index, 3) = dulieu(index, 3) + dulieu(k, 3)
End If
Next
.ClearContents
.Parent.Range("A2").Resize(k, 3).Value = dulieu
End With
End Sub


[/GPECODE]

Em gởi anh

Không hiểu sao xoá thì nó đã xoá rồi. Nhưng nó cộng giá trị bị sai ạ
Em gởi file và Code của anh ở file kèm. Anh check xem nhé. Em check kết quả tính tổng nó bị sai mất.

 

[nmhung49]

Em gởi anh

Không hiểu sao xoá thì nó đã xoá rồi. Nhưng nó cộng giá trị bị sai ạ
Em gởi file và Code của anh ở file kèm. Anh check xem nhé. Em check kết quả tính tổng nó bị sai mất.

Sơ xuất tôi viết lộn k nếu đúng là chữ i ban sửa lại thành vậy chỗ này

dulieu(index, 3) = dulieu(index, 3) + dulieu(i, 3)

 

[vanlemon]

Sơ xuất tôi viết lộn k nếu đúng là chữ i ban sửa lại thành vậy chỗ này

dulieu(index, 3) = dulieu(index, 3) + dulieu(i, 3)

Anh cho em hỏi thêm 1 lần nữa anh nhé

Em xin gởi file kèm ạ

Code Macro là:

Sub Macro1()
'
' Macro1 Macro
'

'
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!C[-1]:C,2,0)"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B19")
Range("B1:B19").Select


End Sub



Vấn đề em gặp phải là Marcro này sẽ fill xuống ô B19 là cuối cùng.
Tuy nhiên dữ liệu của em nó thay đổi, khi thì ô B10 là cuối, khi thì B100 là cuối
Có cách nào cho nó tự fill đến ô cuối cùng của cột A có dữ liệu không anh?

 

[hung2412]

Anh cho em hỏi thêm 1 lần nữa anh nhé

Em xin gởi file kèm ạ

Code Macro là:

Sub Macro1()
'
' Macro1 Macro
'

'
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!C[-1]:C,2,0)"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B19")
Range("B1:B19").Select


End Sub



Vấn đề em gặp phải là Marcro này sẽ fill xuống ô B19 là cuối cùng.
Tuy nhiên dữ liệu của em nó thay đổi, khi thì ô B10 là cuối, khi thì B100 là cuối
Có cách nào cho nó tự fill đến ô cuối cùng của cột A có dữ liệu không anh?

Bạn thử sửa chỗ này Selection.AutoFill Destination:=Range("B1:B19") thành Selection.AutoFill Destination:=Range("B1:B" & [A65536].End(xlUp).Row & "")

 

[vanlemon]

Bạn thử sửa chỗ này Selection.AutoFill Destination:=Range("B1:B19") thành Selection.AutoFill Destination:=Range("B1:B" & [A65536].End(xlUp).Row & "")

Tuyệt luôn bạn ơi
À bạn cho mình hỏi cái. Là tại sao phải click 2 phát nó mới thực hiện Macro trên nhỉ?
Bạn có thể giải thích câu lệnh của bạn cho mình được không ạ?

 

[hung2412]

Tuyệt luôn bạn ơi
À bạn cho mình hỏi cái. Là tại sao phải click 2 phát nó mới thực hiện Macro trên nhỉ?

Cái này tôi không rõ (Có thể bạn kích trượt hoặc không mạnh tay).

Bạn có thể giải thích câu lệnh của bạn cho mình được không ạ?

Câu lệnh Selection.AutoFill Destination:=Range("B1:B" & [A65536].End(xlUp).Row & "") là nó lấy vùng từ B1 đến dòng cuối cùng có dữ liệu của cột A. Câu lệnh [A65536].End(xlUp).Row là từ dòng 65536 chạy ngược lên dòng có dữ liệu cuối cùng tại cột A
Bạn thử Record New Macro như sau: Từ ô ở dòng cuối cùng có dữ liệu ở cột A (Ví dụ ô A19 là dòng cuối cùng có dữ liệu tại cột A) bạn nhấn Ctrl + Mũi tên đi xuống rồi lại nhấn Ctrl + Mũi tên đi lên xem.