Chuyển đổi dữ liệu bằng VBA

Liên hệ QC

phamdatqt

Thành viên mới
Tham gia
28/1/16
Bài viết
6
Được thích
0
Chào mọi người !
Lời đầu tiên mình xin cám ơn các bạn đã đọc bài viết này. Mình post lên đây file cần các bạn trợ giúp bằng cách can thiệp bằng code VBA ( Mình còn kém VBA nghiên cứu mãi chưa làm được ).Tại mình đang thực hiện công việc này hàng tháng. Trong khi dữ liệu khá nhiều. Vậy nên kính mong các bạn giúp mình.
File có 2 sheet. 1 Sheet dữ liệu nguồn: Sheet này số cột và hàng không thay đổi. Tuy nhiên giá trị vùng B2:AF43 là thay đổi tùy theo tháng. Sheet còn lại là kiểu mà dữ liệu mình muốn chuyển từ Sheet kia sang sheet này.
Nếu được mong các bạn giúp mình với ạ. ( Nếu trong quá trình chuyển mà vẫn dữ được các comment ở các ô thì tốt)
*** Tại dữ liệu liên quan đến Công ty nên giá trị ở vùng B2:AF43 mình không thể cung cấp thực được.

MONG NHẬN ĐƯỢC HỖ TRỢ TỪ CÁC BẠN. CHÚC MỌI NGƯỜI CÓ 1 NGÀY VUI VẼ !
Xin cám ơn.
 

File đính kèm

  • file.xlsx
    20.8 KB · Đọc: 12
Lần chỉnh sửa cuối:
Chào mọi người !
Lời đầu tiên mình xin cám ơn các bạn đã đọc bài viết này. Mình post lên đây file cần các bro trợ giúp bằng cách can thiệp bằng code VBA ( Mình còn kém VBA nghiên cứu mãi chưa làm được ).Tại mình đang thực hiện công việc này hàng tháng. Trong khi dữ liệu khá nhiều. Vậy nên kính mong các Bro giúp mình.
File có 2 sheet. 1 Sheet dữ liệu nguồn: Sheet này số cột và hàng không thay đổi. Tuy nhiên giá trị vùng B2:AF43 là thay đổi tùy theo tháng. Sheet còn lại là kiểu mà dữ liệu mình muốn chuyển từ Sheet kia sang sheet này.
Nếu được mong các Bro giúp minh với ạ. ( Nếu trong quá trình chuyển mà vẫn dữ được các comment ở các ô thì tốt)
-P/S: Tại dữ liệu liên quan đến Công ty nên giá trị ở vùng B2:AF43 mình không thể cung cấp thực được.

MONG NHẬN ĐƯỢC HỖ TRỢ TỪ CÁC BRO. CHÚC MỌI NGƯỜI CÓ 1 NGÀY VUI VẼ !
Xin cám ơn.
Theo tôi biết thì trong diễn đàn này chẳng có ai Pro cả đâu, chính vì vậy bạn sẽ đợi rất lâu mới hy vọng sẽ có Pro vào đây giúp.
 
Upvote 0
Theo tôi biết thì trong diễn đàn này chẳng có ai Pro cả đâu, chính vì vậy bạn sẽ đợi rất lâu mới hy vọng sẽ có Pro vào đây giúp.
Bạn hiểu sai ý mình rồi. Bro= Brother chứ k fải Pro như bạn nghĩ. Với lại mình post lên để mong được trợ giúp. Hy vọng ai đó có thể giúp được mình. Tks bạn !
 
Lần chỉnh sửa cuối:
Upvote 0
Theo tôi biết thì trong diễn đàn này chẳng có ai Pro cả đâu, chính vì vậy bạn sẽ đợi rất lâu mới hy vọng sẽ có Pro vào đây giúp.

Không phải Pơ rổ mà Bợ rọ bạn ơi. Dùng tiếng giang hồ này tức là ngừoi ta chỉ muốn giao thiệp với giới cùng trạng tuổi, và cùng môi trường với mình.
Tôi không biết bạn bao nhiêu tuổi, nhưng chắc chắn là những người như tôi không thể được coi là "ngừoi anh em" của họ.
 
Upvote 0
Lần sau rút kinh nghiệm nhé!
Dùng tiếng Việt thôi.
code cho file mẫu của bạn, nếu thực tế thế nào thì tự sửa nhé.
-------------------------------------------------------------------------------------

Sub loc()
Dim data As Range, cll As Range
Dim i As Long
Set data = Sheet1.Range("B2:SF43")
i = 1
Application.ScreenUpdating = False
With Sheet2
.Range("A2:E" & .Range("A1048576").End(xlUp).Row + 3).ClearComments
.Range("A2:E" & .Range("A1048576").End(xlUp).Row + 3).ClearContents
For Each cll In data
If cll.Value <> "" Then
i = i + 1
.Range("A" & i) = Sheet1.Range("A1").Value
.Range("B" & i) = cll.Offset(-cll.Row + 1).Value
.Range("C" & i) = cll.Value
.Range("D" & i) = cll.Offset(0, -cll.Column + 1).Value

If Not cll.Comment Is Nothing Then
With .Range("C" & i)
.AddComment
.Comment.Text Text:=cll.Comment.Text
.Comment.Shape.TextFrame.AutoSize = True
End With
End If
End If
Next
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Không phải Pơ rổ mà Bợ rọ bạn ơi. Dùng tiếng giang hồ này tức là ngừoi ta chỉ muốn giao thiệp với giới cùng trạng tuổi, và cùng môi trường với mình.
Tôi không biết bạn bao nhiêu tuổi, nhưng chắc chắn là những người như tôi không thể được coi là "ngừoi anh em" của họ.
Mình luôn tôn trọng mọi người. Chính vì không biết
Lần sau rút kinh nghiệm nhé!
Dùng tiếng Việt thôi.
code cho file mẫu của bạn, nếu thực tế thế nào thì tự sửa nhé.
-------------------------------------------------------------------------------------

Sub loc()
Dim data As Range, cll As Range
Dim i As Long
Set data = Sheet1.Range("B2:SF43")
i = 1
Application.ScreenUpdating = False
With Sheet2
.Range("A2:E" & .Range("A1048576").End(xlUp).Row + 3).ClearComments
.Range("A2:E" & .Range("A1048576").End(xlUp).Row + 3).ClearContents
For Each cll In data
If cll.Value <> "" Then
i = i + 1
.Range("A" & i) = Sheet1.Range("A1").Value
.Range("B" & i) = cll.Offset(-cll.Row + 1).Value
.Range("C" & i) = cll.Value
.Range("D" & i) = cll.Offset(0, -cll.Column + 1).Value

If Not cll.Comment Is Nothing Then
With .Range("C" & i)
.AddComment
.Comment.Text Text:=cll.Comment.Text
.Comment.Shape.TextFrame.AutoSize = True
End With
End If
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Cám ơn bạn nhiều. Mình sẽ rút kinh nghiệm và sẽ đọc lại nội quy khi tham gia diễn đàn. Mong mọi người bỏ qua sai phạm không mong muốn trên.
 
Upvote 0
Mình luôn tôn trọng mọi người. Chính vì không biết

Cám ơn bạn nhiều. Mình sẽ rút kinh nghiệm và sẽ đọc lại nội quy khi tham gia diễn đàn. Mong mọi người bỏ qua sai phạm không mong muốn trên.
Bạn vẫn có thể sửa nội dung bài viết ở #1 được mà.
Tặng bạn 1 file,
 

File đính kèm

  • GPE_001.xlsb
    26.8 KB · Đọc: 12
Upvote 0
Mình luôn tôn trọng mọi người. Chính vì không biết

Cám ơn bạn nhiều. Mình sẽ rút kinh nghiệm và sẽ đọc lại nội quy khi tham gia diễn đàn. Mong mọi người bỏ qua sai phạm không mong muốn trên.
code sửa lại vùng data cho đúng với dữ liệu của bạn.(viết nhầm A với S)
Set data = Sheet1.Range("B2:SF43")
thành:
Set data = Sheet1.Range("B2:AF43")
 
Upvote 0
Bạn vẫn có thể sửa nội dung bài viết ở #1 được mà.
Tặng bạn 1 file,
Vâng cảm ơn Anh Ba Tê. Em đã sửa lại nội dung. Và cảm ơn Anh về file hỗ trợ. Anh cho Em hỏi thêm là có cách nào có thể chuyển dữ liệu kèm theo comment của Ô nằm trong sheet Data qua sheet GPE không Anh ? Nếu được Anh có thể bổ sung cho Em với được không ạ.
 
Upvote 0
Mình luôn tôn trọng mọi người. Chính vì không biết

Cám ơn bạn nhiều. Mình sẽ rút kinh nghiệm và sẽ đọc lại nội quy khi tham gia diễn đàn. Mong mọi người bỏ qua sai phạm không mong muốn trên.
- Bạn mới 28 tuổi. Vì vậy, bạn nên rút kinh nghiệm trong cách xưng hô, trên diễn đàn chúng ta không biết nhau thì nên xưng hô bạn với nhau là được.
- Nội quy của diễn đàn quy định: Tất cả các bài viết bằng tiếng Việt cần viết có dấu đầy đủ, tránh phạm lỗi chính tả và làm mất đi sự trong sáng của tiếng Việt. Vì vậy, bạn không nên viết chữ Hoa, viết tắt cũng như tiếng Tây, tiếng u trong bài viết.
 
Lần chỉnh sửa cuối:
Upvote 0
Vâng cảm ơn Anh Ba Tê. Em đã sửa lại nội dung. Và cảm ơn Anh về file hỗ trợ. Anh cho Em hỏi thêm là có cách nào có thể chuyển dữ liệu kèm theo comment của Ô nằm trong sheet Data qua sheet GPE không Anh ? Nếu được Anh có thể bổ sung cho Em với được không ạ.
MONG NHẬN ĐƯỢC HỖ TRỢ TỪ CÁC BRO. CHÚC MỌI NGƯỜI CÓ 1 NGÀY VUI VẼ !
 

File đính kèm

  • GPE_001.xlsb
    32.4 KB · Đọc: 14
Upvote 0
Web KT
Back
Top Bottom