📄 -
字号:
VERSION 5.00
Object = "{DD44C0E7-B2CF-11D1-8DD3-444553540000}#1.0#0"; "CELL32.OCX"
Begin VB.Form frm_sjzz
Caption = "数据转置"
ClientHeight = 4575
ClientLeft = 60
ClientTop = 345
ClientWidth = 6840
HelpContextID = 1014004
Icon = "数据转置.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4575
ScaleWidth = 6840
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame1
Caption = "公式选项"
Height = 1065
Left = 5400
TabIndex = 6
Top = 120
Width = 1335
Begin VB.OptionButton Option2
Caption = "返回结果"
Height = 255
Left = 120
TabIndex = 8
Top = 630
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "返回公式"
Height = 375
Left = 120
TabIndex = 7
Top = 240
Value = -1 'True
Width = 1095
End
End
Begin VB.CommandButton Command5
Caption = "复原"
Height = 375
Left = 5550
TabIndex = 5
Top = 3180
Width = 1095
End
Begin VB.CommandButton Command4
Caption = "取消(&C)"
Height = 375
Left = 5550
TabIndex = 4
Top = 4080
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "确定(&O)"
Height = 375
Left = 5550
TabIndex = 3
Top = 3630
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "行反向"
Height = 375
Left = 5550
TabIndex = 2
Top = 2730
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "列反向"
Height = 375
Left = 5550
TabIndex = 1
Top = 2280
Width = 1095
End
Begin CELLLib.Cell Cell1
Height = 4335
Left = 120
TabIndex = 0
Top = 120
Width = 5175
_Version = 65536
_ExtentX = 9128
_ExtentY = 7646
_StockProps = 0
End
End
Attribute VB_Name = "frm_sjzz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************
'* 模 块 名 称 :数据转置
'* 功 能 描 述 :
'* 程序员姓名 :奚俊峰
'* 最后修改人 :奚俊峰
'* 最后修改时间:2002/01/21
'***********************************************
Option Explicit
Private Sub Command1_Click()
Dim i As Long, j As Long, ll_cols As Long, ll_rows As Long
Dim lvar_data1, lvar_data2, ll_cell1 As Long, ll_cell2 As Long '标记是否为公式,0公式，1数据
ll_cols = Cell1.Cols
ll_rows = Cell1.Rows
For i = 0 To ll_cols \ 2 - 1
For j = 0 To ll_rows - 1
If Cell1.IsFormulaCell(i, j) Then
Cell1.DoGetFormula i, j, lvar_data1
ll_cell1 = 0
Else
Cell1.DoGetCellData i, j, lvar_data1
ll_cell1 = 1
End If
If Cell1.IsFormulaCell(ll_cols - i - 1, j) Then
Cell1.DoGetFormula ll_cols - i - 1, j, lvar_data2
ll_cell2 = 0
Else
Cell1.DoGetCellData ll_cols - i - 1, j, lvar_data2
ll_cell2 = 1
End If
If ll_cell1 = 0 Then
Cell1.DoClearCell ll_cols - i - 1, j, 0
Cell1.DoSetFormula ll_cols - i - 1, j, lvar_data1
Else
If lvar_data1 = "" Then
Cell1.DoClearCell ll_cols - i - 1, j, 0
Cell1.DoClearCell ll_cols - i - 1, j, 0
Else
Cell1.DoClearCell ll_cols - i - 1, j, 0
Cell1.DoSetCellData ll_cols - i - 1, j, lvar_data1
End If
End If
If ll_cell2 = 0 Then
Cell1.DoClearCell i, j, 0
Cell1.DoSetFormula i, j, lvar_data2
Else
If lvar_data2 = "" Then
Cell1.DoClearCell i, j, 0
Cell1.DoClearCell i, j, 0
Else
Cell1.DoClearCell i, j, 0
Cell1.DoSetCellData i, j, lvar_data2
End If
End If
Next j
Next i
Cell1.DoCalculateAll
Cell1.DoRedrawAll
End Sub
Private Sub command2_Click()
Dim i As Long, j As Long, ll_cols As Long, ll_rows As Long
Dim lvar_data1, lvar_data2, ll_cell1 As Long, ll_cell2 As Long '标记是否为公式,0公式，1数据
ll_cols = Cell1.Cols
ll_rows = Cell1.Rows
For i = 0 To ll_rows \ 2 - 1
For j = 0 To ll_cols - 1
If Cell1.IsFormulaCell(j, i) Then
Cell1.DoGetFormula j, i, lvar_data1
ll_cell1 = 0
Else
Cell1.DoGetCellData j, i, lvar_data1
ll_cell1 = 1
End If
If Cell1.IsFormulaCell(j, ll_rows - i - 1) Then
Cell1.DoGetFormula j, ll_rows - i - 1, lvar_data2
ll_cell2 = 0
Else
Cell1.DoGetCellData j, ll_rows - i - 1, lvar_data2
ll_cell2 = 1
End If
If ll_cell1 = 0 Then
Cell1.DoClearCell j, ll_rows - i - 1, 0
Cell1.DoSetFormula j, ll_rows - i - 1, lvar_data1
Else
If lvar_data1 = "" Then
Cell1.DoClearCell j, ll_rows - i - 1, 0
Cell1.DoClearCell j, ll_rows - i - 1, 0
Else
Cell1.DoClearCell j, ll_rows - i - 1, 0
Cell1.DoSetCellData j, ll_rows - i - 1, lvar_data1
End If
End If
If ll_cell2 = 0 Then
Cell1.DoClearCell j, i, 0
Cell1.DoSetFormula j, i, lvar_data2
Else
If lvar_data2 = "" Then
Cell1.DoClearCell j, i, 0
Cell1.DoClearCell j, i, 0
Else
Cell1.DoClearCell j, i, 0
Cell1.DoSetCellData j, i, lvar_data2
End If
End If
Next j
Next i
Cell1.DoCalculateAll
Cell1.DoRedrawAll
End Sub
Private Sub Command3_Click()
Dim ll_col_begin, ll_row_begin
Dim ll_col_end, ll_row_end
Dim i As Long, j As Long
Dim lvar_data
With MDI_frame.ActiveForm
.Cell1.DoGetSelectRange ll_col_begin, ll_row_begin, ll_col_end, ll_row_end
For i = 0 To ll_col_end - ll_col_begin
For j = 0 To ll_row_end - ll_row_begin
.Cell1.DoClearCell i + ll_col_begin, j + ll_row_begin, 0
.Cell1.DoClearCell i + ll_col_begin, j + ll_row_begin, 0
If Cell1.IsFormulaCell(i, j) And Option1.Value = True Then
Cell1.DoGetFormula i, j, lvar_data
.Cell1.DoSetFormula i + ll_col_begin, j + ll_row_begin, lvar_data
Else
Cell1.DoGetCellData i, j, lvar_data
If lvar_data = "" Then
.Cell1.DoClearCell i + ll_col_begin, j + ll_row_begin, 0
.Cell1.DoClearCell i + ll_col_begin, j + ll_row_begin, 0
Else
.Cell1.DoSetCellData i + ll_col_begin, j + ll_row_begin, lvar_data
End If
End If
Next j
Next i
.Cell1.DoRedrawAll
End With
Unload Me
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Command5_Click()
Dim ll_col_begin, ll_row_begin
Dim ll_col_end, ll_row_end
Dim i As Long, j As Long
Dim lvar_data
Cell1.CalcManaually = 0
With MDI_frame.ActiveForm
.Cell1.DoGetSelectRange ll_col_begin, ll_row_begin, ll_col_end, ll_row_end
For i = 0 To ll_col_end - ll_col_begin
For j = 0 To ll_row_end - ll_row_begin
If .Cell1.IsFormulaCell(i + ll_col_begin, j + ll_row_begin) Then
.Cell1.DoGetFormula i + ll_col_begin, j + ll_row_begin, lvar_data
Cell1.DoSetFormula i, j, lvar_data
Else
.Cell1.DoGetCellData i + ll_col_begin, j + ll_row_begin, lvar_data
If lvar_data = "" Then
Cell1.DoClearCell i, j, 0
Cell1.DoClearCell i, j, 0
Else
Cell1.DoSetCellData i, j, lvar_data
End If
End If
Next j
Next i
End With
Cell1.DoRedrawAll
End Sub
Private Sub Form_Load()
Dim ll_col_begin, ll_row_begin
Dim ll_col_end, ll_row_end
Dim i As Long, j As Long
Dim lvar_data
Cell1.CalcManaually = 0
With MDI_frame.ActiveForm
.Cell1.DoGetSelectRange ll_col_begin, ll_row_begin, ll_col_end, ll_row_end
Cell1.Cols = ll_col_end - ll_col_begin + 1
Cell1.Rows = ll_row_end - ll_row_begin + 1
For i = 0 To ll_col_end - ll_col_begin
For j = 0 To ll_row_end - ll_row_begin
If .Cell1.IsFormulaCell(i + ll_col_begin, j + ll_row_begin) Then
.Cell1.DoGetFormula i + ll_col_begin, j + ll_row_begin, lvar_data
Cell1.DoSetFormula i, j, lvar_data
Else
.Cell1.DoGetCellData i + ll_col_begin, j + ll_row_begin, lvar_data
If lvar_data <> "" Then
Cell1.DoSetCellData i, j, lvar_data
End If
End If
Next j
Next i
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -