code copy sheets này sang sheets kia theo TargetRange.Offset(i, 0) (1 người xem)

  • Thread starter Thread starter nad582
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

nad582

Thành viên thường trực
Tham gia
7/6/11
Bài viết
317
Được thích
48
Em ko hiểu về VBA lắm...
Nhờ các anh chị trong GPE giúp em tạo sub()
copy những dữ liệu ở sheets "Element_Forces___Frames"
sang sheet "copy" theo các mục ở row1 tại ô A3..
(nó sẽ chạy từng hàng ,, những ô có công thức cũng chạy theo
đến hết phần tử Frame thì thôi)
dựa vào các code ở dưới, tại em muốn cho vba chạy đẹp 1 chút, em cảm ơn nhiều!!!!

Range("a1:j1").Copy TargetRange.Offset(i, 0)
TargetRange.Offset(i, 0).Activate
TargetRange.Offset(i, 0).Value =... 'Frame
TargetRange.Offset(i, 1).Value =…. ' Station
TargetRange.Offset(i, 2).Value =…' OutputCase
TargetRange.Offset(i, 3).Value =…' L
TargetRange.Offset(i, 4).Value = …'P
TargetRange.Offset(i, 5).Value = …'V2
TargetRange.Offset(i, 6).Value = …'V3
TargetRange.Offset(i, 7).Value =…'M2
TargetRange.Offset(i, 8).Value = …'M3

Trong đó: L là max của "Station" theo "Frame"…
 
Lần chỉnh sửa cuối:
Tôi đọc yêu cầu của bạn mà tôi chẳng hiểu cụ thể là gì hết.

Nhìn trong sheet tôi cũng chẳng thấy công thức nào cả

Nhìn kết quả trong bảng copy, tôi cũng chẳng đoán được bắt nguồn từ đâu, kết quả sẽ như thế nào.

Bạn cần phải cho biết chính xác cái bạn cần là gì và kết quả mong đợi như thế nào bạn nhé.
 
Upvote 0
ý mình là:
đại khái là như file đình kèm dưới này
thay vì copy dữ liệu từ file Access thì copy dữ liệu từ sheets này sang sheets kia...
nhờ các bạn giupp1 giùm mình....
xin cảm ơn nhiều!!!!
 
Upvote 0
ý mình là:
đại khái là như file đình kèm dưới này
thay vì copy dữ liệu từ file Access thì copy dữ liệu từ sheets này sang sheets kia...
nhờ các bạn giupp1 giùm mình....
xin cảm ơn nhiều!!!!

Copy hết toàn bộ từ sheet Nguồn sang sheet Gốc hay sao? Hay có điều kiện gì không?
 
Upvote 0
Copy hết toàn bộ từ sheet Nguồn sang sheet Gốc hay sao? Hay có điều kiện gì không?
copy những dữ liệu ở sheets "Element_Forces___Frames"
sang sheet "copy" theo các mục ở row1 tại ô A3..
không có điều kiện gì cả!!
nhưng làm sao cho nó hoạt động giống như file "copy" dữ liệu vậy đó
 
Upvote 0
copy những dữ liệu ở sheets "Element_Forces___Frames"
sang sheet "copy" theo các mục ở row1 tại ô A3..
không có điều kiện gì cả!!
nhưng làm sao cho nó hoạt động giống như file "copy" dữ liệu vậy đó

Tôi vẫn chả hiểu gì cả?

Tôi chưa nói gì về VBA, tôi chỉ làm thủ công, có phải bạn muốn kết quả như sheet copy ở file tôi gửi phải không?
 

File đính kèm

Upvote 0
Tôi vẫn chả hiểu gì cả?
thôi e cám ơn các anh, không được cũng không sao?
vậy có thể giải thích code này giùm em được ko: (đặt biệt tại những chổ màu đỏ)

Sub FromAccessTableCOLUMN(DBFullName As String, TargetRange As Range)
Dim i, j, Cco, seri
Dim cn As ADODB.Connection, Rs As ADODB.Recordset, intColIndex As Integer
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
'tìm các CPU ?ang ch?y c?a máy
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
'l?p hi?n th? ID c?a t?ng CPU
For Each objItem In colItems
t = objItem.ProcessorId
Next
seri = 2073004635
If (t = "BFEBFBFF00020655") And (seri = GetHDDserial) Then
Set TargetRange = TargetRange.Cells(1, 1)
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set Rs = New ADODB.Recordset
If Column.op1.Value = True Then
Cco = 0
Call Delete_All
Else
Cco = Dem() - 1
End If
ActiveSheet.Unprotect ("@@@SOHOACH@@@")
With Rs
.Open "SELECT [Element Forces - Frames].Frame,[Frame Section Assignments].DesignSect,[Element Forces - Frames].Station,[Element Forces - Frames].OutputCase,[Connectivity - Frame].length,[Frame Section Properties 01 - General].t3,[Frame Section Properties 01 - General].t2,[Element Forces - Frames].P,[Element Forces - Frames].M2,[Element Forces - Frames].M3,[Element Forces - Frames].V2,[Element Forces - Frames].V3 FROM [Element Forces - Frames],[Frame Section Assignments],[Connectivity - Frame],[Frame Section Properties 01 - General] WHERE [Element Forces - Frames].Frame = [Connectivity - Frame].Frame and [Frame Section Assignments].DesignSect=[Frame Section Properties 01 - General].SectionName and [Frame Section Assignments].Frame = [Element Forces - Frames].Frame ", cn, , , adCmdText
.MoveFirst
i = 1
i = i + Cco
Range("a13").Select
Do
If (Left(.Fields(1).Value, 1) <> "d") And (Left(.Fields(1).Value, 1) <> "D") Then
.MoveNext
Else
Range("a12:t12").Copy TargetRange.Offset(i, 0)
TargetRange.Offset(i, 0).Activate 'ko co gi
TargetRange.Offset(i, 0).Value = "STORY"
TargetRange.Offset(i, 1).Value = .Fields(0).Value 'ten phan tu
TargetRange.Offset(i, 2).Value = .Fields(2).Value 'vi tri tiet dien
TargetRange.Offset(i, 3).Value = .Fields(3).Value 'truong hop bao
TargetRange.Offset(i, 4).Value = Math.Round(Math.Abs(.Fields(5).Value), 5) * 100 'H
TargetRange.Offset(i, 5).Value = Math.Round(Math.Abs(.Fields(6).Value), 5) * 100 'B
TargetRange.Offset(i, 6).Value = Cells(2, 11).Value 'a
TargetRange.Offset(i, 7).Value = Math.Round(Math.Abs(.Fields(4).Value), 5) 'L
TargetRange.Offset(i, 8).Value = Math.Abs(.Fields(7).Value) 'N
TargetRange.Offset(i, 9).Value = .Fields(8).Value 'M2
TargetRange.Offset(i, 10).Value = .Fields(9).Value 'M3
TargetRange.Offset(i, 11).Value = Math.Abs(.Fields(10).Value) 'V2
TargetRange.Offset(i, 12).Value = Math.Abs(.Fields(11).Value) 'V3
.MoveNext
i = i + 1
End If
Loop Until .EOF
Rows("13:19727").Select
Selection.Sort Key1:=Range("A13"), Order1:=xlAscending, Key2:=Range("B13" _
), Order2:=xlAscending, Key3:=Range("C13"), Order3:=xlAscending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Range("a13").Select
End With
ActiveSheet.Protect ("@@@SOHOACH@@@")
Rs.Close
Set Rs = Nothing
cn.Close
Set cn = Nothing
Else
MsgBox "Lien he tac gia Ths.Hoach, So DT:0918322435"
ActiveWorkbook.Close
End If
End Sub
Sub Delete_All()
' Macro recorded 03/03/2011 by THACH SOM SO HOACH
ActiveSheet.Unprotect ("@@@SOHOACH@@@")
Range("a12").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 1).Select
Loop
usedrows = Selection.Row - 1
If usedrows < 13 Then
Range("B13").Select
ActiveSheet.Protect ("@@@SOHOACH@@@")
Exit Sub
End If
Range("a13", "v" & usedrows).Select
Selection.ClearContents
Selection.ClearFormats
Selection.FormatConditions.Delete
Range("a13").Select
ActiveSheet.Protect ("@@@SOHOACH@@@")
End Sub

Function Dem()
Dim jj
ActiveSheet.Unprotect ("@@@SOHOACH@@@")
Range("a12").Select
jj = 0
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 1).Select
jj = jj + 1
Loop
Dem = jj
Range("a13").Select
ActiveSheet.Protect ("@@@SOHOACH@@@")
End Function
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom